- Timestamp:
- 2013-11-14T12:04:31+01:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r3867_MERCATOR1_DYN/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r3771 r4193 31 31 USE sbc_oce, ONLY : nn_fsbc ! ocean space and time domain 32 32 USE trc_oce, ONLY : nn_dttrc ! !: frequency of step on passive tracers 33 USE icb_oce, ONLY : class_num ! !: iceberg classes 33 34 USE domngb ! ocean space and time domain 34 35 USE phycst ! physical constants … … 36 37 USE xios 37 38 # endif 39 USE ioipsl, ONLY : ju2ymds ! for calendar 38 40 39 41 IMPLICIT NONE … … 52 54 PRIVATE iom_p1d, iom_p2d, iom_p3d 53 55 #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 56 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 57 PRIVATE set_grid, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 56 58 # endif 57 59 … … 98 100 clname = "nemo" 99 101 IF( TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 102 # if defined key_mpp_mpi 100 103 CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 104 # else 105 CALL xios_context_initialize(TRIM(clname), 0) 106 # endif 101 107 CALL iom_swap 102 108 … … 123 129 CALL iom_set_axis_attr( "depthw", gdepw_0 ) 124 130 # if defined key_floats 125 CALL iom_set_axis_attr( "nfloat", ( ji, ji=1,nfloat) )131 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 126 132 # endif 133 CALL iom_set_axis_attr( "icbcla", class_num ) 127 134 128 135 ! automatic definitions of some of the xml attributs … … 130 137 131 138 ! end file definition 132 dtime%second=rdt133 134 135 136 139 dtime%second = rdt 140 CALL xios_set_timestep(dtime) 141 CALL xios_close_context_definition() 142 143 CALL xios_update_calendar(0) 137 144 #endif 138 145 139 146 END SUBROUTINE iom_init 140 147 … … 174 181 LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 175 182 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)183 CHARACTER(LEN=256) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu] 184 CHARACTER(LEN=256) :: cltmpn ! tempory name to store clname (in writting mode) 178 185 CHARACTER(LEN=10) :: clsuffix ! ".nc" or ".dimg" 179 186 CHARACTER(LEN=15) :: clcpu ! the cpu number (max jpmax_digits digits) 180 CHARACTER(LEN= 100) :: clinfo ! info character187 CHARACTER(LEN=256) :: clinfo ! info character 181 188 LOGICAL :: llok ! check the existence 182 189 LOGICAL :: llwrt ! local definition of ldwrt … … 561 568 REAL(wp) :: zscf, zofs ! sacle_factor and add_offset 562 569 INTEGER :: itmp ! temporary integer 563 CHARACTER(LEN= 100) :: clinfo ! info character564 CHARACTER(LEN= 100) :: clname ! file name570 CHARACTER(LEN=256) :: clinfo ! info character 571 CHARACTER(LEN=256) :: clname ! file name 565 572 CHARACTER(LEN=1) :: clrankpv, cldmspc ! 566 573 !--------------------------------------------------------------------- … … 1010 1017 !!---------------------------------------------------------------------- 1011 1018 1012 1013 1019 #if defined key_iomput 1014 1020 1015 SUBROUTINE iom_set_domain_attr( cd name, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, &1021 SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, & 1016 1022 & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask ) 1017 CHARACTER(LEN=*) , INTENT(in) :: cd name1023 CHARACTER(LEN=*) , INTENT(in) :: cdid 1018 1024 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1019 1025 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj … … 1022 1028 LOGICAL, DIMENSION(:,:), OPTIONAL, INTENT(in) :: mask 1023 1029 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, 1030 IF ( xios_is_valid_domain (cdid) ) THEN 1031 CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1032 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1033 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1028 1034 & lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 1029 1035 ENDIF 1030 1036 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, 1037 IF ( xios_is_valid_domaingroup(cdid) ) THEN 1038 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1039 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1040 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1035 1041 & lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 1036 1042 ENDIF 1043 CALL xios_solve_inheritance() 1037 1044 1038 1045 END SUBROUTINE iom_set_domain_attr 1039 1046 1040 1047 1041 SUBROUTINE iom_set_axis_attr( cd name, paxis )1042 CHARACTER(LEN=*) , INTENT(in) :: cd name1048 SUBROUTINE iom_set_axis_attr( cdid, paxis ) 1049 CHARACTER(LEN=*) , INTENT(in) :: cdid 1043 1050 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 ) 1051 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=size(paxis),value=paxis ) 1052 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=size(paxis),value=paxis ) 1053 CALL xios_solve_inheritance() 1046 1054 END SUBROUTINE iom_set_axis_attr 1047 1055 1048 1056 1049 SUBROUTINE iom_set_field_attr( cd name, freq_op)1050 CHARACTER(LEN=*) , INTENT(in) :: cd name1057 SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset ) 1058 CHARACTER(LEN=*) , INTENT(in) :: cdid 1051 1059 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 ) 1060 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_offset 1061 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1062 IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1063 CALL xios_solve_inheritance() 1054 1064 END SUBROUTINE iom_set_field_attr 1055 1065 1056 1066 1057 SUBROUTINE iom_set_file_attr( cd name, name, name_suffix )1058 CHARACTER(LEN=*) , INTENT(in) :: cd name1067 SUBROUTINE iom_set_file_attr( cdid, name, name_suffix ) 1068 CHARACTER(LEN=*) , INTENT(in) :: cdid 1059 1069 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 ) 1070 IF ( xios_is_valid_file (cdid) ) CALL xios_set_file_attr ( cdid, name=name, name_suffix=name_suffix ) 1071 IF ( xios_is_valid_filegroup(cdid) ) CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix ) 1072 CALL xios_solve_inheritance() 1062 1073 END SUBROUTINE iom_set_file_attr 1063 1074 1064 1075 1065 SUBROUTINE iom_set_grid_attr( cdname, mask ) 1066 CHARACTER(LEN=*) , INTENT(in) :: cdname 1076 SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq ) 1077 CHARACTER(LEN=*) , INTENT(in ) :: cdid 1078 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix, output_freq 1079 LOGICAL :: llexist1,llexist2,llexist3 1080 !--------------------------------------------------------------------- 1081 IF( PRESENT( name ) ) name = '' ! default values 1082 IF( PRESENT( name_suffix ) ) name_suffix = '' 1083 IF( PRESENT( output_freq ) ) output_freq = '' 1084 IF ( xios_is_valid_file (cdid) ) THEN 1085 CALL xios_solve_inheritance() 1086 CALL xios_is_defined_file_attr ( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3) 1087 IF(llexist1) CALL xios_get_file_attr ( cdid, name = name ) 1088 IF(llexist2) CALL xios_get_file_attr ( cdid, name_suffix = name_suffix ) 1089 IF(llexist3) CALL xios_get_file_attr ( cdid, output_freq = output_freq ) 1090 ENDIF 1091 IF ( xios_is_valid_filegroup(cdid) ) THEN 1092 CALL xios_solve_inheritance() 1093 CALL xios_is_defined_filegroup_attr( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3) 1094 IF(llexist1) CALL xios_get_filegroup_attr( cdid, name = name ) 1095 IF(llexist2) CALL xios_get_filegroup_attr( cdid, name_suffix = name_suffix ) 1096 IF(llexist3) CALL xios_get_filegroup_attr( cdid, output_freq = output_freq ) 1097 ENDIF 1098 END SUBROUTINE iom_get_file_attr 1099 1100 1101 SUBROUTINE iom_set_grid_attr( cdid, mask ) 1102 CHARACTER(LEN=*) , INTENT(in) :: cdid 1067 1103 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 ) 1104 IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask=mask ) 1105 IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask=mask ) 1106 CALL xios_solve_inheritance() 1070 1107 END SUBROUTINE iom_set_grid_attr 1071 1108 … … 1073 1110 SUBROUTINE set_grid( cdgrd, plon, plat ) 1074 1111 !!---------------------------------------------------------------------- 1075 !! *** ROUTINE ***1112 !! *** ROUTINE set_grid *** 1076 1113 !! 1077 1114 !! ** Purpose : define horizontal grids … … 1101 1138 END SELECT 1102 1139 ! 1103 CALL iom_set_domain_attr( "grid_"//cdgrd , mask = zmask(:,:,1) /= 0. )1104 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = zmask(:,:,:) /= 0. )1140 CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni,nj /)) /= 0. ) 1141 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. ) 1105 1142 ENDIF 1106 1143 … … 1110 1147 SUBROUTINE set_scalar 1111 1148 !!---------------------------------------------------------------------- 1112 !! *** ROUTINE ***1149 !! *** ROUTINE set_scalar *** 1113 1150 !! 1114 1151 !! ** Purpose : define fake grids for scalar point … … 1126 1163 SUBROUTINE set_xmlatt 1127 1164 !!---------------------------------------------------------------------- 1128 !! *** ROUTINE ***1165 !! *** ROUTINE set_xmlatt *** 1129 1166 !! 1130 1167 !! ** Purpose : automatic definitions of some of the xml attributs... 1131 1168 !! 1132 1169 !!---------------------------------------------------------------------- 1133 CHARACTER(len=6),DIMENSION( 8) :: clsuff ! suffix name1134 1170 CHARACTER(len=1),DIMENSION( 3) :: clgrd ! suffix name 1135 CHARACTER(len= 50) :: clname ! filename1171 CHARACTER(len=256) :: clsuff ! suffix name 1136 1172 CHARACTER(len=1) :: cl1 ! 1 character 1137 1173 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 1174 INTEGER :: ji, jg ! loop counters 1143 1175 INTEGER :: ix, iy ! i-,j- index 1144 1176 REAL(wp) ,DIMENSION(11) :: zlontao ! longitudes of tao moorings … … 1150 1182 !!---------------------------------------------------------------------- 1151 1183 ! 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 1184 ! 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') 1185 WRITE(cl1,'(i1)') 1 ; CALL iom_set_field_attr('field_definition', freq_op = cl1//'ts', freq_offset='0ts') 1186 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC' , freq_op = cl1//'ts', freq_offset='0ts') 1187 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('ptrc_T' , freq_op = cl1//'ts', freq_offset='0ts') 1188 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('diad_T' , freq_op = cl1//'ts', freq_offset='0ts') 1163 1189 1164 1190 ! 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 1191 DO ji = 1, 9 1192 WRITE(cl1,'(i1)') ji 1193 CALL iom_update_file_name('file'//cl1) 1194 END DO 1195 DO ji = 1, 99 1196 WRITE(cl2,'(i2.2)') ji 1197 CALL iom_update_file_name('file'//cl2) 1187 1198 END DO 1188 1199 … … 1193 1204 ! Equatorial section (attributs: jbegin, ni, name_suffix) 1194 1205 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') 1206 CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo) 1207 CALL iom_get_file_attr ('Eq'//cl1, name_suffix = clsuff ) 1208 CALL iom_set_file_attr ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') 1209 CALL iom_update_file_name('Eq'//cl1) 1197 1210 END DO 1198 1211 ! TAO moorings (attributs: ibegin, jbegin, name_suffix) … … 1214 1227 SUBROUTINE set_mooring( plon, plat) 1215 1228 !!---------------------------------------------------------------------- 1216 !! *** ROUTINE ***1229 !! *** ROUTINE set_mooring *** 1217 1230 !! 1218 1231 !! ** Purpose : automatic definitions of moorings xml attributs... … … 1223 1236 !!$ CHARACTER(len=1),DIMENSION(4) :: clgrd = (/ 'T', 'U', 'V', 'W' /) ! suffix name 1224 1237 CHARACTER(len=1),DIMENSION(1) :: clgrd = (/ 'T' /) ! suffix name 1225 CHARACTER(len=50) :: clname ! file name 1238 CHARACTER(len=256) :: clname ! file name 1239 CHARACTER(len=256) :: clsuff ! suffix name 1226 1240 CHARACTER(len=1) :: cl1 ! 1 character 1227 1241 CHARACTER(len=6) :: clon,clat ! name of longitude, latitude … … 1269 1283 ENDIF 1270 1284 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)) 1285 CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy) 1286 CALL iom_get_file_attr (TRIM(clname)//cl1, name_suffix = clsuff ) 1287 CALL iom_set_file_attr (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname)) 1288 CALL iom_update_file_name(TRIM(clname)//cl1) 1273 1289 END DO 1274 1290 END DO … … 1277 1293 END SUBROUTINE set_mooring 1278 1294 1295 1296 SUBROUTINE iom_update_file_name( cdid ) 1297 !!---------------------------------------------------------------------- 1298 !! *** ROUTINE iom_update_file_name *** 1299 !! 1300 !! ** Purpose : 1301 !! 1302 !!---------------------------------------------------------------------- 1303 CHARACTER(LEN=*) , INTENT(in) :: cdid 1304 ! 1305 CHARACTER(LEN=256) :: clname 1306 CHARACTER(LEN=20) :: clfreq 1307 CHARACTER(LEN=20) :: cldate 1308 INTEGER :: idx 1309 INTEGER :: jn 1310 INTEGER :: itrlen 1311 INTEGER :: iyear, imonth, iday, isec 1312 REAL(wp) :: zsec 1313 LOGICAL :: llexist 1314 !!---------------------------------------------------------------------- 1315 1316 DO jn = 1,2 1317 1318 IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = clfreq ) 1319 IF( jn == 2 ) CALL iom_get_file_attr( cdid, name_suffix = clname ) 1320 1321 IF ( TRIM(clname) /= '' ) THEN 1322 1323 idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') 1324 DO WHILE ( idx /= 0 ) 1325 clname = clname(1:idx-1)//TRIM(cexper)//clname(idx+9:LEN_TRIM(clname)) 1326 idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') 1327 END DO 1328 1329 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1330 DO WHILE ( idx /= 0 ) 1331 IF ( TRIM(clfreq) /= '' ) THEN 1332 itrlen = LEN_TRIM(clfreq) 1333 IF ( clfreq(itrlen-1:itrlen) == 'mo' ) clfreq = clfreq(1:itrlen-1) 1334 clname = clname(1:idx-1)//TRIM(clfreq)//clname(idx+6:LEN_TRIM(clname)) 1335 ELSE 1336 CALL ctl_stop('error in the name of file id '//TRIM(cdid), & 1337 & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) ) 1338 ENDIF 1339 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1340 END DO 1341 1342 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 1343 DO WHILE ( idx /= 0 ) 1344 cldate = iom_sdate( fjulday - rdttra(1) / rday ) 1345 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname)) 1346 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 1347 END DO 1348 1349 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 1350 DO WHILE ( idx /= 0 ) 1351 cldate = iom_sdate( fjulday - rdttra(1) / rday, ldfull = .TRUE. ) 1352 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname)) 1353 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 1354 END DO 1355 1356 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 1357 DO WHILE ( idx /= 0 ) 1358 cldate = iom_sdate( fjulday + rdttra(1) / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. ) 1359 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname)) 1360 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 1361 END DO 1362 1363 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 1364 DO WHILE ( idx /= 0 ) 1365 cldate = iom_sdate( fjulday + rdttra(1) / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. ) 1366 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname)) 1367 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 1368 END DO 1369 1370 IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname ) 1371 IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname ) 1372 1373 ENDIF 1374 1375 END DO 1376 1377 END SUBROUTINE iom_update_file_name 1378 1379 1380 FUNCTION iom_sdate( pjday, ld24, ldfull ) 1381 !!---------------------------------------------------------------------- 1382 !! *** ROUTINE iom_sdate *** 1383 !! 1384 !! ** Purpose : send back the date corresponding to the given julian day 1385 !! 1386 !!---------------------------------------------------------------------- 1387 REAL(wp), INTENT(in ) :: pjday ! julian day 1388 LOGICAL , INTENT(in ), OPTIONAL :: ld24 ! true to force 24:00 instead of 00:00 1389 LOGICAL , INTENT(in ), OPTIONAL :: ldfull ! true to get the compleate date: yyyymmdd_hh:mm:ss 1390 ! 1391 CHARACTER(LEN=20) :: iom_sdate 1392 CHARACTER(LEN=50) :: clfmt ! format used to write the date 1393 INTEGER :: iyear, imonth, iday, ihour, iminute, isec 1394 REAL(wp) :: zsec 1395 LOGICAL :: ll24, llfull 1396 ! 1397 IF( PRESENT(ld24) ) THEN ; ll24 = ld24 1398 ELSE ; ll24 = .FALSE. 1399 ENDIF 1400 1401 IF( PRESENT(ldfull) ) THEN ; llfull = ldfull 1402 ELSE ; llfull = .FALSE. 1403 ENDIF 1404 1405 CALL ju2ymds( pjday, iyear, imonth, iday, zsec ) 1406 isec = NINT(zsec) 1407 1408 IF ( ll24 .AND. isec == 0 ) THEN ! 00:00 of the next day -> move to 24:00 of the current day 1409 CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec ) 1410 isec = 86400 1411 ENDIF 1412 1413 IF( iyear < 10000 ) THEN ; clfmt = "i4.4,2i2.2" ! format used to write the date 1414 ELSE ; WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1 1415 ENDIF 1416 1417 IF( llfull ) THEN 1418 clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" 1419 ihour = isec / 3600 1420 isec = MOD(isec, 3600) 1421 iminute = isec / 60 1422 isec = MOD(isec, 60) 1423 WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday, ihour, iminute, isec ! date of the end of run 1424 ELSE 1425 WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday ! date of the end of run 1426 ENDIF 1427 1428 END FUNCTION iom_sdate 1429 1279 1430 #else 1280 1431 … … 1285 1436 1286 1437 #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 1438 1297 1439 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.
