Changeset 1703 for trunk/NEMO/OFF_SRC/DIA
- Timestamp:
- 2009-11-03T14:25:58+01:00 (15 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OFF_SRC/DIA/dianam.F90
r1672 r1703 4 4 !! Ocean diagnostics: Builds output file name 5 5 !!===================================================================== 6 !! History : OPA ! 1999-02 (E. Guilyardi) Creation for 30 days/month 7 !! NEMO 1.0 ! 2002-06 (G. Madec) F90: Free form and module 8 !! 3.2 ! 2009-11 (S. Masson) complete rewriting, works for all calendars... 9 !!---------------------------------------------------------------------- 6 10 7 11 !!---------------------------------------------------------------------- 8 12 !! dia_nam : Builds output file name 9 13 !!---------------------------------------------------------------------- 10 !! * Modules used11 14 USE dom_oce ! ocean space and time domain 12 15 USE phycst ! physical constants 13 16 USE in_out_manager ! I/O manager 14 17 USE daymod ! calendar 18 USE ioipsl, ONLY : ju2ymds ! for calendar 15 19 16 20 IMPLICIT NONE 17 21 PRIVATE 18 22 19 !! * Routine accessibility20 PUBLIC dia_nam ! routine called by step.F90 23 PUBLIC dia_nam 24 21 25 !!---------------------------------------------------------------------- 22 !! OPA 9.0 , LOCEAN-IPSL (2005)26 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 23 27 !! $Id$ 24 28 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt … … 34 38 !! 35 39 !! ** Method : File name is a function of date and output frequency 36 !! cdfnam=<cexper>_<clave>_<idtbeg>_<idtend>_ grid_<cdsuff>40 !! cdfnam=<cexper>_<clave>_<idtbeg>_<idtend>_<cdsuff> 37 41 !! <clave> = averaging frequency (DA, MO, etc...) 38 42 !! <idtbeg>,<idtend> date of beginning and end of run 39 43 !! 40 !! History :41 !! ! 99-02 (E. Guilyardi) Creation for 30 days/month42 !! 8.5 ! 02-06 (G. Madec) F90: Free form and module43 44 !!---------------------------------------------------------------------- 44 !! * Arguments 45 CHARACTER (len=*), INTENT( out ) :: cdfnam ! file name 46 CHARACTER (len=*), INTENT( in ) :: cdsuff ! ??? 47 INTEGER, INTENT( in ) :: kfreq ! ??? 48 49 !! * Local declarations 50 CHARACTER (len=2) :: clave 51 CHARACTER (len=3) :: clave1 52 CHARACTER (len=5) :: clout 53 INTEGER :: jt ! dummy loop indices 54 INTEGER :: ig, ijjmm, iout ! temporary integers 55 INTEGER :: iyear1, imonth1, iday1 ! " " 56 INTEGER :: iyear2, imonth2, iday2 ! " " 57 REAL(wp) :: z5j, znbsec, zdate1, zdate2, zdrun, zdt ! temporary scalars 45 CHARACTER (len=*), INTENT( out) :: cdfnam ! file name 46 CHARACTER (len=*), INTENT(in ) :: cdsuff ! to be added at the end of the file name 47 INTEGER, INTENT(in ) :: kfreq ! output frequency (in time-step): < 0 for monthly outputs 48 ! 0 if no frequency 49 CHARACTER (len=20) :: clfmt, clfmt0 ! writing format 50 CHARACTER (len=20) :: clave ! name for output frequency 51 CHARACTER (len=20) :: cldate1 ! date of the beginning of run 52 CHARACTER (len=20) :: cldate2 ! date of the end of run 53 INTEGER :: iyear1, imonth1, iday1 ! year, month, day of the first day of the run 54 INTEGER :: iyear2, imonth2, iday2 ! year, month, day of the last day of the run 55 INTEGER :: indg ! number of digits needed to write a number 56 INTEGER :: inbsec, inbmn, inbhr, inbday, inbyr ! output frequency in seconds, minutes, hours, days and years 57 INTEGER :: iddss, ihhss, immss ! number of seconds in 1 day, 1 hour and 1 minute 58 REAL(wp) :: zsec1, zsec2 ! not used 59 REAL(wp) :: zdrun, zjul ! temporary scalars 58 60 !!---------------------------------------------------------------------- 59 61 … … 63 65 IF(lwp) WRITE(numout,*) 64 66 65 ! 0. Initialisation 66 ! ----------------- 67 ! name for output frequency 67 68 68 cdfnam = '' 69 70 ! number of seconds of the run 71 72 z5j = 5*rjjss 73 zdt = rdt 74 IF( nacc == 1 ) zdt = rdtmin 75 zdrun = FLOAT( nitend - nit000 ) * zdt 76 77 ! date of beginning of run 78 79 iyear1 = ndastp/10000 80 imonth1 = ndastp/100 - iyear1*100 81 iday1 = ndastp - imonth1*100 - iyear1*10000 82 IF( nleapy == 1) THEN 83 ijjmm=0 84 IF( MOD( iyear1, 4 ) == 0 ) THEN 85 DO jt = 1, imonth1-1 86 ijjmm = ijjmm + nbiss(jt) 87 END DO 88 ELSE 89 DO jt = 1, imonth1-1 90 ijjmm = ijjmm + nobis(jt) 91 END DO 69 inbsec = kfreq * NINT( rdttra(1) ) ! output frequency in seconds 70 iddss = NINT( rday ) ! number of seconds in 1 day 71 ihhss = NINT( rmmss * rhhmm ) ! number of seconds in 1 hour 72 immss = NINT( rmmss ) ! number of seconds in 1 minute 73 clfmt0 = "('(a,i',i1,',a)')" ! format '(a,ix,a)' with x to be defined 74 ! 75 IF( inbsec == 0 ) THEN ; clave = '' ! no frequency 76 ELSEIF( inbsec < 0 ) THEN ; clave = '_1m' ! frequency in month 77 ELSEIF( MOD( inbsec, iddss ) == 0 ) THEN ! frequency in days 78 inbday = inbsec / iddss 79 indg = INT(LOG10(REAL(inbday,wp))) + 1 ! number of digits needed to write days frequency 80 WRITE(clfmt, clfmt0) indg ; WRITE(clave, clfmt) '_', inbday, 'd' 81 IF( inbday == nmonth_len(nmonth) ) clave = '_1m' 82 IF( MOD( inbday, nyear_len(1) ) == 0 ) THEN ! frequency in years 83 inbyr = inbday / nyear_len(1) 84 indg = INT(LOG10(REAL(inbyr ,wp))) + 1 ! number of digits needed to write years frequency 85 WRITE(clfmt, clfmt0) indg ; WRITE(clave, clfmt) '_', inbyr, 'y' 92 86 ENDIF 93 ijjmm = ijjmm + (iyear1-1)/4 94 zdate1 = ( (iyear1-1)*365 + ijjmm +iday1-1 ) * rjjss 95 ELSE IF( nleapy == 0 ) THEN 96 ijjmm = 0 97 DO jt = 1, imonth1-1 98 ijjmm = ijjmm + nobis(jt) 99 END DO 100 zdate1 = ( (iyear1-1)*raajj + ijjmm + iday1-1)* rjjss 101 ELSE 102 zdate1 = ( (iyear1-1)*nleapy*raamo + (imonth1-1)*nleapy + iday1-1)* rjjss 87 ELSEIF( MOD( inbsec, ihhss ) == 0 ) THEN ! frequency in hours 88 inbhr = inbsec / ihhss 89 indg = INT(LOG10(REAL(inbhr ,wp))) + 1 ! number of digits needed to write hours frequency 90 WRITE(clfmt, clfmt0) indg ; WRITE(clave, clfmt) '_', inbhr, 'h' 91 ELSEIF( MOD( inbsec, immss ) == 0 ) THEN ! frequency in minutes 92 inbmn = inbsec / immss 93 indg = INT(LOG10(REAL(inbmn ,wp))) + 1 ! number of digits needed to write minutes frequency 94 WRITE(clfmt, clfmt0) indg ; WRITE(clave, clfmt) '_', inbmn, 'mn' 95 ELSE ! frequency in seconds 96 indg = INT(LOG10(REAL(inbsec,wp))) + 1 ! number of digits needed to write seconds frequency 97 WRITE(clfmt, clfmt0) indg ; WRITE(clave, clfmt) '_', inbsec, 's' 103 98 ENDIF 104 99 105 ! date of end of run (= date of beginning of next run)100 ! date of the beginning and the end of the run 106 101 107 zdate2 = zdate1 + zdrun 108 IF( nleapy == 1 ) THEN 109 iyear2 = zdate2/(365.25*rjjss)+1 110 ijjmm = INT(zdate2/rjjss)-365*(iyear2-1)-(iyear2-1)/4 111 IF( ijjmm < 0 ) THEN 112 iyear2 = iyear2-1 113 ijjmm = zdate2/rjjss-365.*(iyear2-1)-(iyear2-1)/4 114 ENDIF 115 IF( MOD( iyear2, 4 ) == 0 ) THEN 116 DO jt = 1, 12 117 ijjmm = ijjmm - nbiss(jt) 118 IF( ijjmm <= 0 ) go to 10 119 END DO 120 jt = 12 121 10 CONTINUE 122 imonth2 = jt 123 ijjmm = 0 124 DO jt = 1, jt-1 125 ijjmm = ijjmm + nbiss(jt) 126 END DO 127 ELSE 128 DO jt = 1, 12 129 ijjmm = ijjmm - nobis(jt) 130 IF( ijjmm <= 0 ) go to 15 131 END DO 132 jt = 12 133 15 CONTINUE 134 imonth2 = jt 135 ijjmm = 0 136 DO jt = 1, jt-1 137 ijjmm = ijjmm + nobis(jt) 138 END DO 139 ENDIF 140 iday2 = zdate2/rjjss-365.*(iyear2-1)-ijjmm+1-(iyear2-1)/4 141 ELSE IF( nleapy == 0 ) THEN 142 iyear2 = zdate2/raass+1 143 ijjmm = zdate2/rjjss-raajj*(iyear2-1) 144 DO jt = 1, 12 145 ijjmm = ijjmm - nobis(jt) 146 IF(ijjmm <= 0) go to 20 147 END DO 148 jt = 12 149 20 CONTINUE 150 imonth2 = jt 151 ijjmm = 0 152 DO jt = 1, jt-1 153 ijjmm = ijjmm + nobis(jt) 154 END DO 155 iday2 = zdate2/rjjss-raajj*(iyear2-1)-ijjmm+1 156 ELSE 157 zdate2 = zdate2 / rjjss 158 imonth2 = zdate2/FLOAT(nleapy) 159 iday2 = zdate2 - imonth2*FLOAT(nleapy) + 1. 160 iyear2 = imonth2/12 161 imonth2 = imonth2 - iyear2*12 162 imonth2 = imonth2 + 1 163 iyear2 = iyear2 + 1 164 IF( iday2 == 0 ) THEN 165 iday2 = nleapy 166 imonth2 = imonth2 - 1 167 IF( imonth2 == 0 ) THEN 168 imonth2 = 12 169 iyear2 = iyear2 - 1 170 ENDIF 171 ENDIF 102 zdrun = rdttra(1) / rday * REAL( nitend - nit000, wp ) ! length of the run in days 103 zjul = fjulday - rdttra(1) / rday 104 CALL ju2ymds( zjul , iyear1, imonth1, iday1, zsec1 ) ! year/month/day of the beginning of run 105 CALL ju2ymds( zjul + zdrun, iyear2, imonth2, iday2, zsec2 ) ! year/month/day of the end of run 106 107 IF( iyear2 < 10000 ) THEN ; clfmt = "(i4.4,2i2.2)" ! format used to write the date 108 ELSE ; WRITE(clfmt, "('(i',i1,',2i2.2)')") INT(LOG10(REAL(iyear2,wp))) + 1 172 109 ENDIF 173 110 174 175 ! 1. Define time averaging period <nn><type> 176 ! --------------------------------------- 177 178 iout = 0 179 #if defined key_diainstant 180 clave = 'IN' 181 IF( iyear2 <= 99 ) THEN 182 WRITE(cdfnam,9001) iyear1,imonth1,iday1,iyear2,imonth2,iday2 183 ELSE IF( iyear2 <= 999 ) THEN 184 WRITE(cdfnam,9002) iyear1,imonth1,iday1,iyear2,imonth2,iday2 185 ELSE IF( iyear2 <= 9999 ) THEN 186 WRITE(cdfnam,9003) iyear1,imonth1,iday1,iyear2,imonth2,iday2 187 ELSE 188 WRITE(cdfnam,9004) iyear1,imonth1,iday1,iyear2,imonth2,iday2 189 ENDIF 190 #else 191 192 znbsec=kfreq*zdt 193 ! daily output 194 IF( znbsec == rjjss ) THEN 195 clave = '1d' 196 IF( iyear2 <= 99 ) THEN 197 WRITE(cdfnam,9001) iyear1,imonth1,iday1,iyear2,imonth2,iday2 198 ELSE IF( iyear2 <= 999 ) THEN 199 WRITE(cdfnam,9002) iyear1,imonth1,iday1,iyear2,imonth2,iday2 200 ELSE IF( iyear2 <= 9999 ) THEN 201 WRITE(cdfnam,9003) iyear1,imonth1,iday1,iyear2,imonth2,iday2 202 ELSE 203 WRITE(cdfnam,9004) iyear1,imonth1,iday1,iyear2,imonth2,iday2 204 ENDIF 205 ! 5 day output 206 ELSE IF( znbsec == z5j ) THEN 207 clave='5d' 208 IF( iyear2 <= 99 ) THEN 209 WRITE(cdfnam,9001) iyear1,imonth1,iday1,iyear2,imonth2,iday2 210 ELSE IF( iyear2 <= 999 ) THEN 211 WRITE(cdfnam,9002) iyear1,imonth1,iday1,iyear2,imonth2,iday2 212 ELSE IF( iyear2 <= 9999 ) THEN 213 WRITE(cdfnam,9003) iyear1,imonth1,iday1,iyear2,imonth2,iday2 214 ELSE 215 WRITE(cdfnam,9004) iyear1,imonth1,iday1,iyear2,imonth2,iday2 216 ENDIF 217 ! monthly ouput 218 ELSE IF( (znbsec == rmoss .AND. nleapy > 1) .OR. & 219 (znbsec >= 28*rjjss .AND. znbsec <= 31*rjjss .AND. nleapy <= 1) ) THEN 220 clave = '1m' 221 IF( iyear2 <= 99 ) THEN 222 WRITE(cdfnam,9001) iyear1,imonth1,iday1,iyear2,imonth2,iday2 223 ELSE IF( iyear2 <= 999 ) THEN 224 WRITE(cdfnam,9002) iyear1,imonth1,iday1,iyear2,imonth2,iday2 225 ELSE IF( iyear2 <= 9999 ) THEN 226 WRITE(cdfnam,9003) iyear1,imonth1,iday1,iyear2,imonth2,iday2 227 ELSE 228 WRITE(cdfnam,9004) iyear1,imonth1,iday1,iyear2,imonth2,iday2 229 ENDIF 230 ! annual output 231 ELSE IF( (znbsec == raass .AND. nleapy > 1) .OR. & 232 (znbsec >= 365*rjjss .AND. znbsec <= 366*rjjss .AND. nleapy <= 1) ) THEN 233 clave = '1y' 234 IF( iyear2 <= 99 ) THEN 235 WRITE(cdfnam,9001) iyear1,imonth1,iday1,iyear2,imonth2,iday2 236 ELSE IF( iyear2 <= 999 ) THEN 237 WRITE(cdfnam,9002) iyear1,imonth1,iday1,iyear2,imonth2,iday2 238 ELSE IF( iyear2 <= 9999 ) THEN 239 WRITE(cdfnam,9003) iyear1,imonth1,iday1,iyear2,imonth2,iday2 240 ELSE 241 WRITE(cdfnam,9004) iyear1,imonth1,iday1,iyear2,imonth2,iday2 242 ENDIF 243 ELSE IF( (znbsec == 5.*raass .AND. nleapy > 1) .OR. & 244 (znbsec >= 5.*365*rjjss .AND. znbsec <= 5.*366*rjjss .AND. nleapy <= 1) ) THEN 245 clave = '5y' 246 IF( iyear2 <= 99 ) THEN 247 WRITE(cdfnam,9001) iyear1,imonth1,iday1,iyear2,imonth2,iday2 248 ELSE IF( iyear2 <= 999 ) THEN 249 WRITE(cdfnam,9002) iyear1,imonth1,iday1,iyear2,imonth2,iday2 250 ELSE IF( iyear2 <= 9999 ) THEN 251 WRITE(cdfnam,9003) iyear1,imonth1,iday1,iyear2,imonth2,iday2 252 ELSE 253 WRITE(cdfnam,9004) iyear1,imonth1,iday1,iyear2,imonth2,iday2 254 ENDIF 255 ELSE IF( (znbsec == 10.*raass .AND. nleapy > 1) .OR. & 256 (znbsec >= 10.*365*rjjss .AND. znbsec <= 10.*366*rjjss .AND. nleapy <= 1) ) THEN 257 clave1 = '10y' 258 iout = 1 259 IF( iyear2 <= 99 ) THEN 260 WRITE(cdfnam,9001) iyear1,imonth1,iday1,iyear2,imonth2,iday2 261 ELSE IF( iyear2 <= 999 ) THEN 262 WRITE(cdfnam,9002) iyear1,imonth1,iday1,iyear2,imonth2,iday2 263 ELSE IF( iyear2 <= 9999 ) THEN 264 WRITE(cdfnam,9003) iyear1,imonth1,iday1,iyear2,imonth2,iday2 265 ELSE 266 WRITE(cdfnam,9004) iyear1,imonth1,iday1,iyear2,imonth2,iday2 267 ENDIF 268 ELSE 269 270 ! others 271 iout = kfreq 272 ig = 0 273 clout = '' 274 IF( iout <= 9 ) THEN 275 ig = 1 276 WRITE(clout,'(i1.1)') iout 277 ELSE IF( iout <= 99 ) THEN 278 ig = 2 279 WRITE(clout,'(i2.2)') iout 280 ELSE IF( iout <= 999 ) THEN 281 ig = 3 282 WRITE(clout,'(i3.3)') iout 283 ELSE IF( iout <= 9999 ) THEN 284 ig = 4 285 WRITE(clout,'(i4.4)') iout 286 ELSE 287 ig = 5 288 WRITE(clout,'(i5.5)') iout 289 ENDIF 290 clave = 'CU' 291 IF( iyear2 <= 99 ) THEN 292 WRITE(cdfnam,9001) iyear1,imonth1,iday1,iyear2,imonth2,iday2 293 ELSE IF( iyear2 <= 999 ) THEN 294 WRITE(cdfnam,9002) iyear1,imonth1,iday1,iyear2,imonth2,iday2 295 ELSE IF( iyear2 <= 9999 ) THEN 296 WRITE(cdfnam,9003) iyear1,imonth1,iday1,iyear2,imonth2,iday2 297 ELSE 298 WRITE(cdfnam,9004) iyear1,imonth1,iday1,iyear2,imonth2,iday2 299 ENDIF 300 ENDIF 301 #endif 302 IF( iout == 0 ) THEN 303 cdfnam = TRIM(cexper)//"_"//clave//TRIM(cdfnam)//TRIM(cdsuff) 304 ELSE IF( iout == 1 .AND. kfreq > 1 ) THEN 305 cdfnam = TRIM(cexper)//"_"//clave1//TRIM(cdfnam)//TRIM(cdsuff) 306 ELSE 307 cdfnam = TRIM(cexper)//"_"//clave//TRIM(clout)//TRIM(cdfnam)//TRIM(cdsuff) 308 ENDIF 111 WRITE(cldate1, clfmt) iyear1, imonth1, iday1 ! date of the beginning of run 112 WRITE(cldate2, clfmt) iyear2, imonth2, iday2 ! date of the end of run 113 114 cdfnam = TRIM(cexper)//TRIM(clave)//"_"//TRIM(cldate1)//"_"//TRIM(cldate2)//"_"//TRIM(cdsuff) 115 #if defined key_agrif 116 if ( .NOT. Agrif_Root() ) cdfnam = TRIM(Agrif_CFixed())//'_'//TRIM(cdfnam) 117 #endif 309 118 310 119 IF(lwp) WRITE(numout,*) cdfnam 311 120 IF(lwp) WRITE(numout,*) 312 313 ! FORMATS314 315 9001 FORMAT("_",I4.4,2I2.2,"_",I4.4,2I2.2,"_")316 9002 FORMAT("_",I4.4,2I2.2,"_",I4.4,2I2.2,"_")317 9003 FORMAT("_",I4.4,2I2.2,"_",I4.4,2I2.2,"_")318 9004 FORMAT("_",I6.6,2I2.2,"_",I6.6,2I2.2,"_")319 9011 FORMAT("_",I4.4,I2.2,"_",I4.4,I2.2,"_")320 9012 FORMAT("_",I4.4,I2.2,"_",I4.4,I2.2,"_")321 9013 FORMAT("_",I4.4,I2.2,"_",I4.4,I2.2,"_")322 9014 FORMAT("_",I6.6,I2.2,"_",I6.6,I2.2,"_")323 9021 FORMAT("_",I4.4,"_",I4.4,"_")324 9022 FORMAT("_",I4.4,"_",I4.4,"_")325 9023 FORMAT("_",I4.4,"_",I4.4,"_")326 9024 FORMAT("_",I6.6,"_",I6.6,"_")327 121 328 122 END SUBROUTINE dia_nam
Note: See TracChangeset
for help on using the changeset viewer.