Newer
Older
!!
!! ** Purpose : Get final date in double precision YYYYMMDD.HHMMSS format
!!
!! ** Method :
!!
!! ** Action :
!!
!! History :
!! ! 06-03 (K. Mogensen) Original code
!! ! 06-05 (K. Mogensen) Reformatted
!! ! 06-10 (A. Weaver) Cleaning
!! ! 10-05 (D. Lea) Update to month length calculation for NEMO vn3.2
!! ! 2014-09 (D. Lea) Change to call generic routine calc_date
!!----------------------------------------------------------------------
IMPLICIT NONE
!! * Arguments
sparonuz
committed
REAL(wp), INTENT(OUT) :: ddobsfin ! Final date in YYYYMMDD.HHMMSS
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
CALL calc_date( nitend, ddobsfin )
END SUBROUTINE fin_date
SUBROUTINE obs_settypefiles( ntypes, jpmaxnfiles, ifiles, cobstypes, cfiles )
INTEGER, INTENT(IN) :: ntypes ! Total number of obs types
INTEGER, INTENT(IN) :: jpmaxnfiles ! Maximum number of files allowed for each type
INTEGER, DIMENSION(ntypes), INTENT(OUT) :: &
& ifiles ! Out number of files for each type
CHARACTER(len=lca), DIMENSION(ntypes), INTENT(IN) :: &
& cobstypes ! List of obs types
CHARACTER(len=128), DIMENSION(ntypes, jpmaxnfiles), INTENT(IN) :: &
& cfiles ! List of files for all types
!Local variables
INTEGER :: jfile
INTEGER :: jtype
DO jtype = 1, ntypes
ifiles(jtype) = 0
DO jfile = 1, jpmaxnfiles
IF ( trim(cfiles(jtype,jfile)) /= '' ) &
ifiles(jtype) = ifiles(jtype) + 1
END DO
IF ( ifiles(jtype) == 0 ) THEN
CALL ctl_stop( 'Logical for observation type '//TRIM(cobstypes(jtype))// &
& ' set to true but no files available to read' )
ENDIF
IF(lwp) THEN
WRITE(numout,*) ' '//cobstypes(jtype)//' input observation file names:'
DO jfile = 1, ifiles(jtype)
WRITE(numout,*) ' '//TRIM(cfiles(jtype,jfile))
END DO
ENDIF
END DO
END SUBROUTINE obs_settypefiles
SUBROUTINE obs_setinterpopts( ntypes, jtype, ctypein, &
& n2dint_default, n2dint_type, &
& ravglamscl_type, ravgphiscl_type, &
& lfp_indegs_type, lavnight_type, &
& n2dint, ravglamscl, ravgphiscl, &
& lfpindegs, lavnight )
INTEGER, INTENT(IN) :: ntypes ! Total number of obs types
INTEGER, INTENT(IN) :: jtype ! Index of the current type of obs
INTEGER, INTENT(IN) :: n2dint_default ! Default option for interpolation type
INTEGER, INTENT(IN) :: n2dint_type ! Option for interpolation type
REAL(wp), INTENT(IN) :: &
& ravglamscl_type, & !E/W diameter of obs footprint for this type
& ravgphiscl_type !N/S diameter of obs footprint for this type
LOGICAL, INTENT(IN) :: lfp_indegs_type !T=> footprint in degrees, F=> in metres
LOGICAL, INTENT(IN) :: lavnight_type !T=> obs represent night time average
CHARACTER(len=lca), INTENT(IN) :: ctypein
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
INTEGER, DIMENSION(ntypes), INTENT(INOUT) :: &
& n2dint
REAL(wp), DIMENSION(ntypes), INTENT(INOUT) :: &
& ravglamscl, ravgphiscl
LOGICAL, DIMENSION(ntypes), INTENT(INOUT) :: &
& lfpindegs, lavnight
lavnight(jtype) = lavnight_type
IF ( (n2dint_type >= 0) .AND. (n2dint_type <= 6) ) THEN
n2dint(jtype) = n2dint_type
ELSE IF ( n2dint_type == -1 ) THEN
n2dint(jtype) = n2dint_default
ELSE
CALL ctl_stop(' Choice of '//TRIM(ctypein)//' horizontal (2D) interpolation method', &
& ' is not available')
ENDIF
! For averaging observation footprints set options for size of footprint
IF ( (n2dint(jtype) > 4) .AND. (n2dint(jtype) <= 6) ) THEN
IF ( ravglamscl_type > 0._wp ) THEN
ravglamscl(jtype) = ravglamscl_type
ELSE
CALL ctl_stop( 'Incorrect value set for averaging footprint '// &
'scale (ravglamscl) for observation type '//TRIM(ctypein) )
ENDIF
IF ( ravgphiscl_type > 0._wp ) THEN
ravgphiscl(jtype) = ravgphiscl_type
ELSE
CALL ctl_stop( 'Incorrect value set for averaging footprint '// &
'scale (ravgphiscl) for observation type '//TRIM(ctypein) )
ENDIF
lfpindegs(jtype) = lfp_indegs_type
ENDIF
! Write out info
IF(lwp) THEN
IF ( n2dint(jtype) <= 4 ) THEN
WRITE(numout,*) ' '//TRIM(ctypein)// &
& ' model counterparts will be interpolated horizontally'
ELSE IF ( n2dint(jtype) <= 6 ) THEN
WRITE(numout,*) ' '//TRIM(ctypein)// &
& ' model counterparts will be averaged horizontally'
WRITE(numout,*) ' '//' with E/W scale: ',ravglamscl(jtype)
WRITE(numout,*) ' '//' with N/S scale: ',ravgphiscl(jtype)
IF ( lfpindegs(jtype) ) THEN
WRITE(numout,*) ' '//' (in degrees)'
ELSE
WRITE(numout,*) ' '//' (in metres)'
ENDIF
ENDIF
ENDIF
END SUBROUTINE obs_setinterpopts
END MODULE diaobs