Changeset 3940 for trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
- Timestamp:
- 2013-06-26T10:10:12+02:00 (11 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90 (modified) (17 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r3907 r3940 36 36 USE xios 37 37 # endif 38 USE ioipsl, ONLY : ju2ymds ! for calendar 38 39 39 40 IMPLICIT NONE … … 52 53 PRIVATE iom_p1d, iom_p2d, iom_p3d 53 54 #if defined key_iomput 54 PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_ set_grid_attr55 PRIVATE set_grid, set_scalar, set_xmlatt, set_mooring 55 PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr 56 PRIVATE set_grid, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 56 57 # endif 57 58 … … 130 131 131 132 ! end file definition 132 dtime%second=rdt133 134 135 136 133 dtime%second = rdt 134 CALL xios_set_timestep(dtime) 135 CALL xios_close_context_definition() 136 137 CALL xios_update_calendar(0) 137 138 #endif 138 139 139 140 END SUBROUTINE iom_init 140 141 … … 174 175 LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 175 176 176 CHARACTER(LEN= 100) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu]177 CHARACTER(LEN= 100) :: cltmpn ! tempory name to store clname (in writting mode)177 CHARACTER(LEN=256) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu] 178 CHARACTER(LEN=256) :: cltmpn ! tempory name to store clname (in writting mode) 178 179 CHARACTER(LEN=10) :: clsuffix ! ".nc" or ".dimg" 179 180 CHARACTER(LEN=15) :: clcpu ! the cpu number (max jpmax_digits digits) 180 CHARACTER(LEN= 100) :: clinfo ! info character181 CHARACTER(LEN=256) :: clinfo ! info character 181 182 LOGICAL :: llok ! check the existence 182 183 LOGICAL :: llwrt ! local definition of ldwrt … … 561 562 REAL(wp) :: zscf, zofs ! sacle_factor and add_offset 562 563 INTEGER :: itmp ! temporary integer 563 CHARACTER(LEN= 100) :: clinfo ! info character564 CHARACTER(LEN= 100) :: clname ! file name564 CHARACTER(LEN=256) :: clinfo ! info character 565 CHARACTER(LEN=256) :: clname ! file name 565 566 CHARACTER(LEN=1) :: clrankpv, cldmspc ! 566 567 !--------------------------------------------------------------------- … … 1010 1011 !!---------------------------------------------------------------------- 1011 1012 1012 1013 1013 #if defined key_iomput 1014 1014 1015 SUBROUTINE iom_set_domain_attr( cd name, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, &1015 SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, & 1016 1016 & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask ) 1017 CHARACTER(LEN=*) , INTENT(in) :: cd name1017 CHARACTER(LEN=*) , INTENT(in) :: cdid 1018 1018 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1019 1019 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj … … 1022 1022 LOGICAL, DIMENSION(:,:), OPTIONAL, INTENT(in) :: mask 1023 1023 1024 IF ( xios_is_valid_domain (cd name) ) THEN1025 CALL xios_set_domain_attr ( cd name, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, &1026 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj 1027 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, 1024 IF ( xios_is_valid_domain (cdid) ) THEN 1025 CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1026 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1027 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1028 1028 & lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 1029 1029 ENDIF 1030 1030 1031 IF ( xios_is_valid_domaingroup(cd name) ) THEN1032 CALL xios_set_domaingroup_attr( cd name, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, &1033 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj 1034 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, 1031 IF ( xios_is_valid_domaingroup(cdid) ) THEN 1032 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1033 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1034 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1035 1035 & lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 1036 1036 ENDIF 1037 CALL xios_solve_inheritance() 1037 1038 1038 1039 END SUBROUTINE iom_set_domain_attr 1039 1040 1040 1041 1041 SUBROUTINE iom_set_axis_attr( cd name, paxis )1042 CHARACTER(LEN=*) , INTENT(in) :: cd name1042 SUBROUTINE iom_set_axis_attr( cdid, paxis ) 1043 CHARACTER(LEN=*) , INTENT(in) :: cdid 1043 1044 REAL(wp), DIMENSION(:), INTENT(in) :: paxis 1044 IF ( xios_is_valid_axis (cdname) ) CALL xios_set_axis_attr ( cdname, size=size(paxis),value=paxis ) 1045 IF ( xios_is_valid_axisgroup(cdname) ) CALL xios_set_axisgroup_attr( cdname, size=size(paxis),value=paxis ) 1045 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=size(paxis),value=paxis ) 1046 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=size(paxis),value=paxis ) 1047 CALL xios_solve_inheritance() 1046 1048 END SUBROUTINE iom_set_axis_attr 1047 1049 1048 1050 1049 SUBROUTINE iom_set_field_attr( cd name, freq_op)1050 CHARACTER(LEN=*) , INTENT(in) :: cd name1051 SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset ) 1052 CHARACTER(LEN=*) , INTENT(in) :: cdid 1051 1053 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_op 1052 IF ( xios_is_valid_field (cdname) ) CALL xios_set_field_attr ( cdname, freq_op=freq_op ) 1053 IF ( xios_is_valid_fieldgroup(cdname) ) CALL xios_set_fieldgroup_attr( cdname, freq_op=freq_op ) 1054 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_offset 1055 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1056 IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1057 CALL xios_solve_inheritance() 1054 1058 END SUBROUTINE iom_set_field_attr 1055 1059 1056 1060 1057 SUBROUTINE iom_set_file_attr( cd name, name, name_suffix )1058 CHARACTER(LEN=*) , INTENT(in) :: cd name1061 SUBROUTINE iom_set_file_attr( cdid, name, name_suffix ) 1062 CHARACTER(LEN=*) , INTENT(in) :: cdid 1059 1063 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: name, name_suffix 1060 IF ( xios_is_valid_file (cdname) ) CALL xios_set_file_attr ( cdname, name=name, name_suffix=name_suffix ) 1061 IF ( xios_is_valid_filegroup(cdname) ) CALL xios_set_filegroup_attr( cdname, name=name, name_suffix=name_suffix ) 1064 IF ( xios_is_valid_file (cdid) ) CALL xios_set_file_attr ( cdid, name=name, name_suffix=name_suffix ) 1065 IF ( xios_is_valid_filegroup(cdid) ) CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix ) 1066 CALL xios_solve_inheritance() 1062 1067 END SUBROUTINE iom_set_file_attr 1063 1068 1064 1069 1065 SUBROUTINE iom_set_grid_attr( cdname, mask ) 1066 CHARACTER(LEN=*) , INTENT(in) :: cdname 1070 SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq ) 1071 CHARACTER(LEN=*) , INTENT(in ) :: cdid 1072 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix, output_freq 1073 LOGICAL :: llexist1,llexist2,llexist3 1074 !--------------------------------------------------------------------- 1075 IF( PRESENT( name ) ) name = '' ! default values 1076 IF( PRESENT( name_suffix ) ) name_suffix = '' 1077 IF( PRESENT( output_freq ) ) output_freq = '' 1078 IF ( xios_is_valid_file (cdid) ) THEN 1079 CALL xios_solve_inheritance() 1080 CALL xios_is_defined_file_attr ( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3) 1081 IF(llexist1) CALL xios_get_file_attr ( cdid, name = name ) 1082 IF(llexist2) CALL xios_get_file_attr ( cdid, name_suffix = name_suffix ) 1083 IF(llexist3) CALL xios_get_file_attr ( cdid, output_freq = output_freq ) 1084 ENDIF 1085 IF ( xios_is_valid_filegroup(cdid) ) THEN 1086 CALL xios_solve_inheritance() 1087 CALL xios_is_defined_filegroup_attr( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3) 1088 IF(llexist1) CALL xios_get_filegroup_attr( cdid, name = name ) 1089 IF(llexist2) CALL xios_get_filegroup_attr( cdid, name_suffix = name_suffix ) 1090 IF(llexist3) CALL xios_get_filegroup_attr( cdid, output_freq = output_freq ) 1091 ENDIF 1092 END SUBROUTINE iom_get_file_attr 1093 1094 1095 SUBROUTINE iom_set_grid_attr( cdid, mask ) 1096 CHARACTER(LEN=*) , INTENT(in) :: cdid 1067 1097 LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) :: mask 1068 IF ( xios_is_valid_grid (cdname) ) CALL xios_set_grid_attr ( cdname, mask=mask ) 1069 IF ( xios_is_valid_gridgroup(cdname) ) CALL xios_set_gridgroup_attr( cdname, mask=mask ) 1098 IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask=mask ) 1099 IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask=mask ) 1100 CALL xios_solve_inheritance() 1070 1101 END SUBROUTINE iom_set_grid_attr 1071 1102 … … 1073 1104 SUBROUTINE set_grid( cdgrd, plon, plat ) 1074 1105 !!---------------------------------------------------------------------- 1075 !! *** ROUTINE ***1106 !! *** ROUTINE set_grid *** 1076 1107 !! 1077 1108 !! ** Purpose : define horizontal grids … … 1110 1141 SUBROUTINE set_scalar 1111 1142 !!---------------------------------------------------------------------- 1112 !! *** ROUTINE ***1143 !! *** ROUTINE set_scalar *** 1113 1144 !! 1114 1145 !! ** Purpose : define fake grids for scalar point … … 1126 1157 SUBROUTINE set_xmlatt 1127 1158 !!---------------------------------------------------------------------- 1128 !! *** ROUTINE ***1159 !! *** ROUTINE set_xmlatt *** 1129 1160 !! 1130 1161 !! ** Purpose : automatic definitions of some of the xml attributs... 1131 1162 !! 1132 1163 !!---------------------------------------------------------------------- 1133 CHARACTER(len=6),DIMENSION( 8) :: clsuff ! suffix name1134 1164 CHARACTER(len=1),DIMENSION( 3) :: clgrd ! suffix name 1135 CHARACTER(len= 50) :: clname ! filename1165 CHARACTER(len=256) :: clsuff ! suffix name 1136 1166 CHARACTER(len=1) :: cl1 ! 1 character 1137 1167 CHARACTER(len=2) :: cl2 ! 1 character 1138 CHARACTER(len=255) :: tfo 1139 INTEGER :: idt ! time-step in seconds 1140 INTEGER :: iddss, ihhss ! number of seconds in 1 day, 1 hour and 1 year 1141 INTEGER :: iyymo ! number of months in 1 year 1142 INTEGER :: jg, jh, jd, jm, jy ! loop counters 1168 INTEGER :: ji, jg ! loop counters 1143 1169 INTEGER :: ix, iy ! i-,j- index 1144 1170 REAL(wp) ,DIMENSION(11) :: zlontao ! longitudes of tao moorings … … 1150 1176 !!---------------------------------------------------------------------- 1151 1177 ! 1152 idt = NINT( rdttra(1) )1153 iddss = NINT( rday ) ! number of seconds in 1 day1154 ihhss = NINT( rmmss * rhhmm ) ! number of seconds in 1 hour1155 iyymo = NINT( raamo ) ! number of months in 1 year1156 1157 1178 ! frequency of the call of iom_put (attribut: freq_op) 1158 tfo = TRIM(i2str(idt))//'s' 1159 CALL iom_set_field_attr('field_definition', freq_op=tfo) 1160 CALL iom_set_field_attr('SBC' , freq_op=TRIM(i2str(idt* nn_fsbc ))//'s') 1161 CALL iom_set_field_attr('ptrc_T', freq_op=TRIM(i2str(idt* nn_dttrc))//'s') 1162 CALL iom_set_field_attr('diad_T', freq_op=TRIM(i2str(idt* nn_dttrc))//'s') 1179 WRITE(cl1,'(i1)') 1 ; CALL iom_set_field_attr('field_definition', freq_op = cl1//'ts', freq_offset='0ts') 1180 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC' , freq_op = cl1//'ts', freq_offset='0ts') 1181 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('ptrc_T' , freq_op = cl1//'ts', freq_offset='0ts') 1182 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('diad_T' , freq_op = cl1//'ts', freq_offset='0ts') 1163 1183 1164 1184 ! output file names (attribut: name) 1165 clsuff(:) = (/ 'grid_T', 'grid_U', 'grid_V', 'grid_W', 'icemod', 'ptrc_T', 'diad_T', 'scalar' /) 1166 DO jg = 1, SIZE(clsuff) ! grid type 1167 DO jh = 1, 24 ! 1-24 hours 1168 WRITE(cl2,'(i2)') jh 1169 CALL dia_nam( clname, jh * ihhss, clsuff(jg), ldfsec = .TRUE. ) 1170 CALL iom_set_file_attr(TRIM(ADJUSTL(cl2))//'h_'//clsuff(jg), name=TRIM(clname)) 1171 END DO 1172 DO jd = 1, 30 ! 1-30 days 1173 WRITE(cl1,'(i1)') jd 1174 CALL dia_nam( clname, jd * iddss, clsuff(jg), ldfsec = .TRUE. ) 1175 CALL iom_set_file_attr(cl1//'d_'//clsuff(jg), name=TRIM(clname)) 1176 END DO 1177 DO jm = 1, 11 ! 1-11 months 1178 WRITE(cl1,'(i1)') jm 1179 CALL dia_nam( clname, -jm, clsuff(jg) ) 1180 CALL iom_set_file_attr(cl1//'m_'//clsuff(jg), name=TRIM(clname)) 1181 END DO 1182 DO jy = 1, 50 ! 1-50 years 1183 WRITE(cl2,'(i2)') jy 1184 CALL dia_nam( clname, -jy * iyymo, clsuff(jg) ) 1185 CALL iom_set_file_attr(TRIM(ADJUSTL(cl2))//'y_'//clsuff(jg), name=TRIM(clname)) 1186 END DO 1185 DO ji = 1, 9 1186 WRITE(cl1,'(i1)') ji 1187 CALL iom_update_file_name('file'//cl1) 1188 END DO 1189 DO ji = 1, 99 1190 WRITE(cl2,'(i2.2)') ji 1191 CALL iom_update_file_name('file'//cl2) 1187 1192 END DO 1188 1193 … … 1193 1198 ! Equatorial section (attributs: jbegin, ni, name_suffix) 1194 1199 CALL dom_ngb( 0., 0., ix, iy, cl1 ) 1195 CALL iom_set_domain_attr('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo) 1196 CALL iom_set_file_attr('Eq'//cl1, name_suffix= '_Eq') 1200 CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo) 1201 CALL iom_get_file_attr ('Eq'//cl1, name_suffix = clsuff ) 1202 CALL iom_set_file_attr ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') 1203 CALL iom_update_file_name('Eq'//cl1) 1197 1204 END DO 1198 1205 ! TAO moorings (attributs: ibegin, jbegin, name_suffix) … … 1214 1221 SUBROUTINE set_mooring( plon, plat) 1215 1222 !!---------------------------------------------------------------------- 1216 !! *** ROUTINE ***1223 !! *** ROUTINE set_mooring *** 1217 1224 !! 1218 1225 !! ** Purpose : automatic definitions of moorings xml attributs... … … 1223 1230 !!$ CHARACTER(len=1),DIMENSION(4) :: clgrd = (/ 'T', 'U', 'V', 'W' /) ! suffix name 1224 1231 CHARACTER(len=1),DIMENSION(1) :: clgrd = (/ 'T' /) ! suffix name 1225 CHARACTER(len=50) :: clname ! file name 1232 CHARACTER(len=256) :: clname ! file name 1233 CHARACTER(len=256) :: clsuff ! suffix name 1226 1234 CHARACTER(len=1) :: cl1 ! 1 character 1227 1235 CHARACTER(len=6) :: clon,clat ! name of longitude, latitude … … 1269 1277 ENDIF 1270 1278 clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon)) 1271 CALL iom_set_domain_attr(TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy) 1272 CALL iom_set_file_attr(TRIM(clname)//cl1, name_suffix= '_'//TRIM(clname)) 1279 CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy) 1280 CALL iom_get_file_attr (TRIM(clname)//cl1, name_suffix = clsuff ) 1281 CALL iom_set_file_attr (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname)) 1282 CALL iom_update_file_name(TRIM(clname)//cl1) 1273 1283 END DO 1274 1284 END DO … … 1277 1287 END SUBROUTINE set_mooring 1278 1288 1289 1290 SUBROUTINE iom_update_file_name( cdid ) 1291 !!---------------------------------------------------------------------- 1292 !! *** ROUTINE iom_update_file_name *** 1293 !! 1294 !! ** Purpose : 1295 !! 1296 !!---------------------------------------------------------------------- 1297 CHARACTER(LEN=*) , INTENT(in) :: cdid 1298 ! 1299 CHARACTER(LEN=256) :: clname 1300 CHARACTER(LEN=20) :: clfreq 1301 CHARACTER(LEN=20) :: cldate 1302 INTEGER :: idx 1303 INTEGER :: jn 1304 INTEGER :: itrlen 1305 INTEGER :: iyear, imonth, iday, isec 1306 REAL(wp) :: zsec 1307 LOGICAL :: llexist 1308 !!---------------------------------------------------------------------- 1309 1310 DO jn = 1,2 1311 1312 IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = clfreq ) 1313 IF( jn == 2 ) CALL iom_get_file_attr( cdid, name_suffix = clname ) 1314 1315 IF ( TRIM(clname) /= '' ) THEN 1316 1317 idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') 1318 DO WHILE ( idx /= 0 ) 1319 clname = clname(1:idx-1)//TRIM(cexper)//clname(idx+9:LEN_TRIM(clname)) 1320 idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') 1321 END DO 1322 1323 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1324 DO WHILE ( idx /= 0 ) 1325 IF ( TRIM(clfreq) /= '' ) THEN 1326 itrlen = LEN_TRIM(clfreq) 1327 IF ( clfreq(itrlen-1:itrlen) == 'mo' ) clfreq = clfreq(1:itrlen-1) 1328 clname = clname(1:idx-1)//TRIM(clfreq)//clname(idx+6:LEN_TRIM(clname)) 1329 ELSE 1330 CALL ctl_stop('error in the name of file id '//TRIM(cdid), & 1331 & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) ) 1332 ENDIF 1333 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1334 END DO 1335 1336 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 1337 DO WHILE ( idx /= 0 ) 1338 cldate = iom_sdate( fjulday - rdttra(1) / rday ) 1339 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname)) 1340 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 1341 END DO 1342 1343 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 1344 DO WHILE ( idx /= 0 ) 1345 cldate = iom_sdate( fjulday - rdttra(1) / rday, ldfull = .TRUE. ) 1346 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname)) 1347 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 1348 END DO 1349 1350 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 1351 DO WHILE ( idx /= 0 ) 1352 cldate = iom_sdate( fjulday + rdttra(1) / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. ) 1353 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname)) 1354 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 1355 END DO 1356 1357 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 1358 DO WHILE ( idx /= 0 ) 1359 cldate = iom_sdate( fjulday + rdttra(1) / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. ) 1360 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname)) 1361 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 1362 END DO 1363 1364 IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname ) 1365 IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname ) 1366 1367 ENDIF 1368 1369 END DO 1370 1371 END SUBROUTINE iom_update_file_name 1372 1373 1374 FUNCTION iom_sdate( pjday, ld24, ldfull ) 1375 !!---------------------------------------------------------------------- 1376 !! *** ROUTINE iom_sdate *** 1377 !! 1378 !! ** Purpose : send back the date corresponding to the given julian day 1379 !! 1380 !!---------------------------------------------------------------------- 1381 REAL(wp), INTENT(in ) :: pjday ! julian day 1382 LOGICAL , INTENT(in ), OPTIONAL :: ld24 ! true to force 24:00 instead of 00:00 1383 LOGICAL , INTENT(in ), OPTIONAL :: ldfull ! true to get the compleate date: yyyymmdd_hh:mm:ss 1384 ! 1385 CHARACTER(LEN=20) :: iom_sdate 1386 CHARACTER(LEN=50) :: clfmt ! format used to write the date 1387 INTEGER :: iyear, imonth, iday, ihour, iminute, isec 1388 REAL(wp) :: zsec 1389 LOGICAL :: ll24, llfull 1390 ! 1391 IF( PRESENT(ld24) ) THEN ; ll24 = ld24 1392 ELSE ; ll24 = .FALSE. 1393 ENDIF 1394 1395 IF( PRESENT(ldfull) ) THEN ; llfull = ldfull 1396 ELSE ; llfull = .FALSE. 1397 ENDIF 1398 1399 CALL ju2ymds( pjday, iyear, imonth, iday, zsec ) 1400 isec = NINT(zsec) 1401 1402 IF ( ll24 .AND. isec == 0 ) THEN ! 00:00 of the next day -> move to 24:00 of the current day 1403 CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec ) 1404 isec = 86400 1405 ENDIF 1406 1407 IF( iyear < 10000 ) THEN ; clfmt = "i4.4,2i2.2" ! format used to write the date 1408 ELSE ; WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1 1409 ENDIF 1410 1411 IF( llfull ) THEN 1412 clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" 1413 ihour = isec / 3600 1414 isec = MOD(isec, 3600) 1415 iminute = isec / 60 1416 isec = MOD(isec, 60) 1417 WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday, ihour, iminute, isec ! date of the end of run 1418 ELSE 1419 WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday ! date of the end of run 1420 ENDIF 1421 1422 END FUNCTION iom_sdate 1423 1279 1424 #else 1280 1425 … … 1285 1430 1286 1431 #endif 1287 1288 FUNCTION i2str(int)1289 IMPLICIT NONE1290 INTEGER, INTENT(IN) :: int1291 CHARACTER(LEN=255) :: i2str1292 1293 WRITE(i2str,*) int1294 1295 END FUNCTION i2str1296 1432 1297 1433 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
