Changeset 182 for trunk/NEMO
- Timestamp:
- 2004-11-05T15:08:51+01:00 (20 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/DIA/diawri_dimg.h90 (modified) (21 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DIA/diawri_dimg.h90
r32 r182 79 79 !! INTEGER :: iwrite 80 80 INTEGER :: iyear,imon,iday 81 INTEGER, SAVE :: nmoyct 81 82 82 83 #if defined key_diainstant 83 REAL(wp),DIMENSION(jpi,jpj,jpk) :: fsel 84 LOGICAL, PARAMETER :: l_dia_inst=.true. 85 86 REAL(wp), SAVE, DIMENSION (1,1,1) :: um , vm ! dummy arrays for comiplation purpose 87 REAL(wp), SAVE, DIMENSION (1,1,1) :: tm , sm ! 88 REAL(wp), SAVE, DIMENSION (1,1,1) :: fsel ! 89 REAL(wp) :: zdtj 84 LOGICAL, PARAMETER :: ll_dia_inst=.TRUE. !: for instantaneous output 90 85 #else 91 INTEGER, SAVE :: nmoyct 86 LOGICAL, PARAMETER :: ll_dia_inst=.FALSE. !: for average output 87 #endif 92 88 93 89 REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) :: um , vm ! used to compute mean u, v fields 90 REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) :: wm ! used to compute mean w fields 94 91 REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) :: tm , sm ! used to compute mean t, s fields 95 92 REAL(wp), SAVE, DIMENSION (jpi,jpj,jpk) :: fsel ! used to compute mean 2d fields 96 93 REAL(wp) :: zdtj 97 LOGICAL, PARAMETER :: l_dia_inst=.false.98 #endif99 94 ! 100 95 CHARACTER(LEN=80) :: clname … … 128 123 clver='@!01' 129 124 ! 130 IF ( .NOT. l _dia_inst ) THEN125 IF ( .NOT. ll_dia_inst ) THEN 131 126 !#if ! defined key_diainstant 132 127 ! … … 143 138 um(:,:,:) = 0._wp 144 139 vm(:,:,:) = 0._wp 140 wm(:,:,:) = 0._wp 145 141 tm(:,:,:) = 0._wp 146 142 sm(:,:,:) = 0._wp … … 156 152 um(:,:,:)=um(:,:,:) + un (:,:,:) 157 153 vm(:,:,:)=vm(:,:,:) + vn (:,:,:) 154 wm(:,:,:)=wm(:,:,:) + wn (:,:,:) 158 155 tm(:,:,:)=tm(:,:,:) + tn (:,:,:) 159 156 sm(:,:,:)=sm(:,:,:) + sn (:,:,:) … … 192 189 ! IF (abs(adatrj-iwrite*rwrite) < zdtj/2. & 193 190 194 IF ( ( MOD (kt ,nwrite) == 0 ) &191 IF ( ( MOD (kt-nit000+1,nwrite) == 0 ) & 195 192 & .OR. kindic < 0 & 196 193 & .OR. ( kt == 1 .AND. kindic > 0) ) THEN … … 199 196 um(:,:,:) = um(:,:,:) / nmoyct 200 197 vm(:,:,:) = vm(:,:,:) / nmoyct 198 wm(:,:,:) = wm(:,:,:) / nmoyct 201 199 tm(:,:,:) = tm(:,:,:) / nmoyct 202 200 sm(:,:,:) = sm(:,:,:) / nmoyct … … 214 212 ENDIF 215 213 ! 216 ELSE ! l _dia_inst true214 ELSE ! ll_dia_inst true 217 215 !# else 218 216 ! … … 227 225 clmode='instantaneous' 228 226 ! IF (abs(adatrj-iwrite*rwrite) < zdtj/2. & 229 IF ( ( MOD (kt ,nwrite) == 0 ) &227 IF ( ( MOD (kt-nit000+1,nwrite) == 0 ) & 230 228 & .OR. kindic < 0 & 231 229 & .OR. ( kt == 1 .AND. kindic > 0) ) THEN … … 268 266 ! this file gives a record of the dump date for post processing ( ASCII file ) 269 267 ! 270 IF ( ( MOD (kt ,nwrite) == 0 ) &268 IF ( ( MOD (kt-nit000+1,nwrite) == 0 ) & 271 269 & .OR. kindic < 0 & 272 270 & .OR. ( kt == 1 .AND. kindic > 0) ) THEN … … 284 282 IF ( kindic < 0 ) cltext=TRIM(cexper)//' U(m/s) instantaneous (explosion)' 285 283 ! 286 IF ( l _dia_inst) THEN284 IF ( ll_dia_inst) THEN 287 285 CALL dia_wri_dimg(clname, cltext, un, jpk, 'T') 288 286 … … 301 299 cltext=TRIM(cexper)//' V(m/s) '//TRIM(clmode) 302 300 ! 303 IF ( l _dia_inst) THEN301 IF ( ll_dia_inst) THEN 304 302 CALL dia_wri_dimg(clname, cltext, vn, jpk, 'T') 305 303 ELSE … … 317 315 ! 318 316 317 !! * W section 318 319 WRITE(clname,9000) TRIM(cexper),'W',iyear,imon,iday 320 cltext=TRIM(cexper)//' W(m/s) '//TRIM(clmode) 321 322 IF ( ll_dia_inst) THEN 323 CALL dia_wri_dimg(clname, cltext, wn, jpk, 'W') 324 ELSE 325 CALL dia_wri_dimg(clname, cltext, wm, jpk, 'W') 326 END IF 327 319 328 !! * T section 320 329 … … 322 331 cltext=TRIM(cexper)//' T (DegC) '//TRIM(clmode) 323 332 324 IF (l _dia_inst) THEN333 IF (ll_dia_inst) THEN 325 334 CALL dia_wri_dimg(clname, cltext, tn, jpk, 'T') 326 335 ELSE … … 334 343 cltext=TRIM(cexper)//' S (PSU) '//TRIM(clmode) 335 344 336 IF (l _dia_inst) THEN345 IF (ll_dia_inst) THEN 337 346 CALL dia_wri_dimg(clname, cltext, sn, jpk, 'T') 338 347 ELSE … … 346 355 cltext='2D fields '//TRIM(clmode) 347 356 348 IF (l _dia_inst) THEN357 IF (ll_dia_inst) THEN 349 358 CALL dia_wri_dimg(clname, cltext, fsel, inbsel, '2') 350 359 ELSE … … 359 368 IF(lwp)WRITE(numout,*) ' **** WRITE in numwri ',kt 360 369 361 IF(lwp .AND. l _dia_inst) WRITE(numout,*) ' instantaneous fields'362 IF(lwp .AND. .NOT. l _dia_inst ) WRITE(numout,*) ' average fields with ',nmoyct,'pdt'370 IF(lwp .AND. ll_dia_inst) WRITE(numout,*) ' instantaneous fields' 371 IF(lwp .AND. .NOT. ll_dia_inst ) WRITE(numout,*) ' average fields with ',nmoyct,'pdt' 363 372 ! 364 373 ! 365 374 !! * Reset cumulating arrays and counter to 0 after writing 366 375 ! 367 IF ( .NOT. l _dia_inst ) THEN376 IF ( .NOT. ll_dia_inst ) THEN 368 377 nmoyct = 0 369 378 ! … … 399 408 END SUBROUTINE dia_wri_state 400 409 401 SUBROUTINE dia_wri_dimg(cd_name, cd_text, ptab, klev, cd_type )410 SUBROUTINE dia_wri_dimg(cd_name, cd_text, ptab, klev, cd_type , ksubi ) 402 411 !!------------------------------------------------------------------------- 403 412 !! *** ROUTINE dia_wri_dimg *** … … 426 435 CHARACTER(LEN=1),INTENT(in) :: cd_type ! either 'T', 'W' or '2' , depending on the vertical 427 436 ! ! grid for ptab. 2 stands for 2D file 437 INTEGER, INTENT(in), OPTIONAL, DIMENSION(klev) :: ksubi 428 438 429 439 !! * Local declarations … … 442 452 !! * Initialisations 443 453 444 irecl4 = jpi*jpj*sp454 irecl4 = MAX(jpi*jpj*sp , 84+18*sp + (jpk+8)*jpnij*sp ) 445 455 inum = 14 446 456 … … 465 475 z4dep(1:klev) =(/(jk, jk=1,klev)/) 466 476 477 CASE ( 'I' ) 478 z4dep(1:klev) = ksubi(1:klev) 479 467 480 CASE DEFAULT 468 481 IF(lwp) WRITE(numout,*) ' E R R O R : bad cd_type in dia_wri_dimg ' … … 480 493 & (z4dep(1:klev),jn=1,jpnij), & 481 494 & ztimm, & 482 & narea, jpnij,jpiglo,jpjglo, 495 & narea, jpnij,jpiglo,jpjglo,jpizoom, jpjzoom, & ! extension to dimg for mpp output 483 496 & nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt ! 484 497 485 498 !! * Write klev levels 486 DO jk = 1, klev 487 irec =1 + klev * (narea -1) + jk 488 z42d(:,:) = ptab(:,:,jk) 489 WRITE(inum,REC=irec) z42d(:,:) 490 END DO 499 IF ( cd_type == 'I' ) THEN 500 501 DO jk = 1, klev 502 irec =1 + klev * (narea -1) + jk 503 z42d(:,:) = ptab(:,:,ksubi(jk)) 504 WRITE(inum,REC=irec) z42d(:,:) 505 END DO 506 ELSE 507 DO jk = 1, klev 508 irec =1 + klev * (narea -1) + jk 509 z42d(:,:) = ptab(:,:,jk) 510 WRITE(inum,REC=irec) z42d(:,:) 511 END DO 512 ENDIF 491 513 492 514 !! * Close the file
Note: See TracChangeset
for help on using the changeset viewer.
