Changeset 1830 for branches/CMIP5_IPSL/NEMO/TOP_SRC/trcdia.F90
- Timestamp:
- 2010-04-12T15:03:51+02:00 (14 years ago)
- File:
-
- 1 edited
-
branches/CMIP5_IPSL/NEMO/TOP_SRC/trcdia.F90 (modified) (42 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/CMIP5_IPSL/NEMO/TOP_SRC/trcdia.F90
r1715 r1830 21 21 !! trcdib_wr : outputs of biological fields 22 22 !!---------------------------------------------------------------------- 23 USE dom_oce ! ocean space and time domain variables 23 USE dom_oce ! ocean space and time domain variables 24 24 USE oce_trc 25 USE trp_trc 25 26 USE trc 26 USE trp_trc 27 USE par_trc 28 USE trctrp 27 29 USE trdmld_trc_oce, ONLY : luttrd 30 USE iom 28 31 USE dianam ! build name of file (routine) 29 32 USE in_out_manager ! I/O manager … … 41 44 INTEGER :: ndimt50 !: number of ocean points in index array 42 45 INTEGER :: ndimt51 !: number of ocean points in index array 43 REAL(wp) :: xjulian !: ???? not DOCTOR !46 REAL(wp) :: zjulian !: ???? not DOCTOR ! 44 47 INTEGER , DIMENSION (jpij*jpk) :: ndext50 !: integer arrays for ocean 3D index 45 48 INTEGER , DIMENSION (jpij) :: ndext51 !: integer arrays for ocean surface index … … 64 67 !!---------------------------------------------------------------------- 65 68 !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005) 66 !! $ Id$69 !! $Header:$ 67 70 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 68 71 !!---------------------------------------------------------------------- … … 70 73 CONTAINS 71 74 72 SUBROUTINE trc_dia( kt )75 SUBROUTINE trc_dia( kt, kindic ) 73 76 !!--------------------------------------------------------------------- 74 77 !! *** ROUTINE trc_dia *** … … 77 80 !!--------------------------------------------------------------------- 78 81 INTEGER, INTENT( in ) :: kt 79 INTEGER 82 INTEGER :: kindic 80 83 !!--------------------------------------------------------------------- 81 84 … … 110 113 LOGICAL :: ll_print = .FALSE. 111 114 CHARACTER (len=40) :: clhstnam, clop 112 #if defined key_off_tra113 INTEGER :: inum = 11 ! temporary logical unit114 #endif115 115 CHARACTER (len=20) :: cltra, cltrau 116 116 CHARACTER (len=80) :: cltral 117 117 REAL(wp) :: zsto, zout, zdt 118 INTEGER :: iimi, iima, ijmi, ijma, ipk, it , itmod118 INTEGER :: iimi, iima, ijmi, ijma, ipk, it 119 119 !!---------------------------------------------------------------------- 120 120 … … 128 128 ! Define frequency of output and means 129 129 zdt = rdt 130 IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!)131 ELSE ; clop = "x" ! no use of the mask value (require less cpu time)132 ENDIF133 130 # if defined key_diainstant 134 131 zsto = nwritetrc * rdt 135 clop = "inst("//TRIM(clop)//")"132 clop = 'inst(only(x))' 136 133 # else 137 134 zsto = zdt 138 clop = "ave("//TRIM(clop)//")"135 clop = 'ave(only(x))' 139 136 # endif 140 137 zout = nwritetrc * zdt … … 146 143 147 144 ! define time axis 148 itmod = kt - nittrc000 + 1 149 it = kt 145 it = kt - nittrc000 + 1 150 146 151 147 ! Define NETCDF files and fields at beginning of first time step … … 157 153 158 154 ! Compute julian date from starting date of the run 159 CALL ymds2ju( nyear, nmonth, nday, rdt, xjulian ) 160 xjulian = xjulian - adatrj ! set calendar origin to the beginning of the experiment 155 CALL ymds2ju( nyear, nmonth, nday, 0.0, zjulian ) 161 156 IF(lwp)WRITE(numout,*)' ' 162 157 IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000 & 163 158 & ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday & 164 & ,'Julian day : ', xjulian 165 159 & ,'Julian day : ', zjulian 166 160 IF(lwp) WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma, & 167 161 & ' limit storage in depth = ', ipk 168 162 169 #if defined key_off_tra 170 ! WRITE root name in date.file for use by postpro 171 IF(lwp) THEN 172 CALL dia_nam( clhstnam, nwritetrc,' ' ) 173 CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 174 WRITE(inum,*) clhstnam 175 CLOSE(inum) 176 ENDIF 177 #endif 178 179 ! Define the NETCDF files for passive tracer concentration 163 164 ! Define the NETCDF files for passive tracer concentration 165 180 166 CALL dia_nam( clhstnam, nwritetrc, 'ptrc_T' ) 181 167 IF(lwp)WRITE(numout,*)" Name of NETCDF file ", clhstnam 182 183 ! Horizontal grid : glamt and gphit 168 ! Horizontal grid : glamt and gphit 184 169 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 185 170 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 186 & nittrc000-ndttrc, xjulian, zdt, nhorit5, nit5 , domain_id=nidom) 187 188 ! Vertical grid for tracer : gdept 189 CALL histvert( nit5, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepit5) 190 191 ! Index of ocean points in 3D and 2D (surface) 192 CALL wheneq( jpi*jpj*ipk, tmask, 1, 1., ndext50, ndimt50 ) 193 CALL wheneq( jpi*jpj , tmask, 1, 1., ndext51, ndimt51 ) 194 195 ! Declare all the output fields as NETCDF variables 171 & 0, zjulian, zdt, nhorit5, nit5 , domain_id=nidom) 172 ! Vertical grid for tracer : gdept 173 CALL histvert( nit5, 'deptht', 'Vertical T levels', & 174 & 'm', ipk, gdept_0, ndepit5) 175 176 ! Index of ocean points in 3D and 2D (surface) 177 CALL wheneq( jpi*jpj*ipk,tmask,1,1.,ndext50,ndimt50 ) 178 CALL wheneq( jpi*jpj,tmask,1,1.,ndext51,ndimt51 ) 179 180 ! Declare all the output fields as NETCDF variables 181 182 ! tracer concentrations 196 183 DO jn = 1, jptra 197 184 IF( lutsav(jn) ) THEN … … 200 187 cltrau = ctrcun(jn) ! UNIT for tracer 201 188 CALL histdef( nit5, cltra, cltral, cltrau, jpi, jpj, nhorit5, & 202 & ipk, 1, ipk, ndepit5, 32, clop, zsto, zout)189 & ipk, 1, ipk, ndepit5, 32, clop, zsto, zout) 203 190 ENDIF 204 191 END DO … … 215 202 ! --------------------------------------- 216 203 217 IF( lwp .AND. MOD( itmod, nwritetrc ) == 0 ) THEN204 IF( lwp .AND. MOD( kt, nwritetrc ) == 0 ) THEN 218 205 WRITE(numout,*) 'trcdit_wr : write NetCDF passive tracer concentrations at ', kt, 'time-step' 219 206 WRITE(numout,*) '~~~~~~~~~ ' … … 221 208 222 209 DO jn = 1, jptra 223 cltra = ctrcnm(jn) ! short title for tracer 224 IF( lutsav(jn) ) CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 ) 210 IF( lutsav(jn) ) THEN 211 cltra = ctrcnm(jn) ! short title for tracer 212 CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 ) 213 ENDIF 225 214 END DO 215 216 ! synchronise file 217 IF( MOD( kt, nwritetrc ) == 0 .OR. kindic < 0 ) CALL histsync( nit5 ) 218 226 219 227 220 ! close the file … … 229 222 IF( kt == nitend .OR. kindic < 0 ) CALL histclo( nit5 ) 230 223 ! 231 232 224 END SUBROUTINE trcdit_wr 233 225 … … 244 236 !! 245 237 !! At each time step call histdef to compute the mean if necessary 246 !! Each nwritetr dtime step, output the instantaneous or mean fields238 !! Each nwritetrc time step, output the instantaneous or mean fields 247 239 !! 248 240 !! IF kindic <0, output of fields before the model interruption. … … 258 250 CHARACTER (len=80) :: cltral 259 251 CHARACTER (len=10) :: csuff 260 INTEGER :: jn, jl 261 INTEGER :: iimi, iima, ijmi, ijma, ipk, it , itmod252 INTEGER :: jn, jl, ikn 253 INTEGER :: iimi, iima, ijmi, ijma, ipk, it 262 254 REAL(wp) :: zsto, zout, zdt 263 255 !!---------------------------------------------------------------------- … … 265 257 ! 0. Initialisation 266 258 ! ----------------- 267 268 259 269 260 ! local variable for debugging … … 273 264 ! Define frequency of output and means 274 265 zdt = rdt 275 IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!)276 ELSE ; clop = "x" ! no use of the mask value (require less cpu time)277 ENDIF278 266 # if defined key_diainstant 279 267 zsto = nwritetrd * rdt 280 clop = "inst("//TRIM(clop)//")"268 clop = 'inst(only(x))' 281 269 # else 282 270 zsto = zdt 283 clop = "ave("//TRIM(clop)//")"271 clop = 'ave(only(x))' 284 272 # endif 285 273 zout = nwritetrd * zdt … … 291 279 292 280 ! define time axis 293 itmod = kt - nittrc000 + 1 294 it = kt 281 it = kt - nittrc000 + 1 295 282 296 283 ! Define the NETCDF files (one per tracer) … … 313 300 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 314 301 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 315 & nittrc000-ndttrc, xjulian, zdt, nhorit6(jn),&302 & 0, zjulian, rdt, nhorit6(jn), & 316 303 & nit6(jn) , domain_id=nidom ) 317 304 318 305 ! Vertical grid for tracer trend - one per each tracer IF needed 319 CALL histvert( nit6(jn), 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepit6(jn) ) 306 CALL histvert( nit6(jn), 'deptht', 'Vertical T levels', & 307 & 'm', ipk, gdept_0, ndepit6(jn) ) 320 308 END IF 321 309 END DO 322 310 323 311 ! Declare all the output fields as NETCDF variables 324 325 ! trends for tracer concentrations326 312 DO jn = 1, jptra 327 313 IF( luttrd(jn) ) THEN 328 314 DO jl = 1, jpdiatrc 329 IF( jl == 1) THEN315 IF( jl == jptrc_xad ) THEN 330 316 ! short and long title for x advection for tracer 331 317 WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 332 WRITE (cltral,'("X advective trend for ",58a)') & 333 & ctrcnl(jn)(1:58) 334 END IF 335 IF( jl == 2 ) THEN 318 WRITE (cltral,'("X advective trend for ",58a)') ctrcnl(jn)(1:58) 319 END IF 320 IF( jl == jptrc_yad ) THEN 336 321 ! short and long title for y advection for tracer 337 322 WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 338 WRITE (cltral,'("Y advective trend for ",58a)') & 339 & ctrcnl(jn)(1:58) 340 END IF 341 IF( jl == 3 ) THEN 323 WRITE (cltral,'("Y advective trend for ",58a)') ctrcnl(jn)(1:58) 324 END IF 325 IF( jl == jptrc_zad ) THEN 342 326 ! short and long title for Z advection for tracer 343 327 WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 344 WRITE (cltral,'("Z advective trend for ",58a)') & 345 & ctrcnl(jn)(1:58) 346 END IF 347 IF( jl == 4 ) THEN 328 WRITE (cltral,'("Z advective trend for ",58a)') ctrcnl(jn)(1:58) 329 END IF 330 IF( jl == jptrc_xdf ) THEN 348 331 ! short and long title for X diffusion for tracer 349 332 WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 350 WRITE (cltral,'("X diffusion trend for ",58a)') & 351 & ctrcnl(jn)(1:58) 352 END IF 353 IF( jl == 5 ) THEN 333 WRITE (cltral,'("X diffusion trend for ",58a)') ctrcnl(jn)(1:58) 334 END IF 335 IF( jl == jptrc_ydf ) THEN 354 336 ! short and long title for Y diffusion for tracer 355 337 WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 356 WRITE (cltral,'("Y diffusion trend for ",58a)') & 357 & ctrcnl(jn)(1:58) 358 END IF 359 IF( jl == 6 ) THEN 338 WRITE (cltral,'("Y diffusion trend for ",58a)') ctrcnl(jn)(1:58) 339 END IF 340 IF( jl == jptrc_zdf ) THEN 360 341 ! short and long title for Z diffusion for tracer 361 342 WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 362 WRITE (cltral,'("Z diffusion trend for ",58a)') & 363 & ctrcnl(jn)(1:58) 343 WRITE (cltral,'("Z diffusion trend for ",58a)') ctrcnl(jn)(1:58) 364 344 END IF 365 345 # if defined key_trcldf_eiv 366 IF( jl == 7) THEN346 IF( jl == jptrc_xei ) THEN 367 347 ! short and long title for x gent velocity for tracer 368 348 WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) 369 WRITE (cltral,'("X gent velocity trend for ",53a)') & 370 & ctrcnl(jn)(1:53) 371 END IF 372 IF( jl == 8 ) THEN 349 WRITE (cltral,'("X gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 350 END IF 351 IF( jl == jptrc_yei ) THEN 373 352 ! short and long title for y gent velocity for tracer 374 353 WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 375 WRITE (cltral,'("Y gent velocity trend for ",53a)') & 376 & ctrcnl(jn)(1:53) 377 END IF 378 IF( jl == 9 ) THEN 354 WRITE (cltral,'("Y gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 355 END IF 356 IF( jl == jptrc_zei ) THEN 379 357 ! short and long title for Z gent velocity for tracer 380 358 WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 381 WRITE (cltral,'("Z gent velocity trend for ",53a)') & 382 & ctrcnl(jn)(1:53) 359 WRITE (cltral,'("Z gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 383 360 END IF 384 361 # endif 385 362 # if defined key_trcdmp 386 IF( jl == jp diatrc - 1) THEN363 IF( jl == jptrc_dmp ) THEN 387 364 ! last trends for tracer damping : short and long title 388 365 WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 389 WRITE (cltral,'("Tracer damping trend for ",55a)') & 390 & ctrcnl(jn)(1:55) 391 END IF 392 # endif 393 IF( jl == jpdiatrc ) THEN 366 WRITE (cltral,'("Tracer damping trend for ",55a)') ctrcnl(jn)(1:55) 367 END IF 368 # endif 369 IF( jl == jptrc_sbc ) THEN 394 370 ! last trends for tracer damping : short and long title 395 371 WRITE (cltra,'("SBC_",16a)') ctrcnm(jn) 396 WRITE (cltral,'("Surface boundary flux ",58a)') &397 & ctrcnl(jn)(1:58)398 END IF399 372 WRITE (cltral,'("Surface boundary flux ",58a)') ctrcnl(jn)(1:55) 373 END IF 374 WRITE (cltral,'("Surface boundary flux ",58a)') ctrcnl(jn)(1:55) 375 END IF 400 376 CALL FLUSH( numout ) 401 377 cltrau = ctrcun(jn) ! UNIT for tracer /trends … … 425 401 ! trends for tracer concentrations 426 402 427 IF( lwp .AND. MOD( itmod, nwritetrd ) == 0 ) THEN403 IF( lwp .AND. MOD( kt, nwritetrd ) == 0 ) THEN 428 404 WRITE(numout,*) 'trcdid_wr : write NetCDF dynamical trends at ', kt, 'time-step' 429 405 WRITE(numout,*) '~~~~~~ ' … … 432 408 DO jn = 1, jptra 433 409 IF( luttrd(jn) ) THEN 410 ikn = ikeep(jn) 434 411 DO jl = 1, jpdiatrc 435 ! short titles 436 IF( jl == 1) WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) ! x advection for tracer437 IF( jl == 2) WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) ! z advection for tracer438 IF( jl == 3) WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) ! z advection for tracer439 IF( jl == 4) WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) ! x diffusion for tracer440 IF( jl == 5) WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) ! y diffusion for tracer441 IF( jl == 6) WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) ! z diffusion for tracer412 ! short titles 413 IF( jl == jptrc_xad) WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 414 IF( jl == jptrc_yad) WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 415 IF( jl == jptrc_zad) WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 416 IF( jl == jptrc_xdf) WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 417 IF( jl == jptrc_ydf) WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 418 IF( jl == jptrc_zdf) WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 442 419 # if defined key_trcldf_eiv 443 IF( jl == 7) WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) ! x gent velocity for tracer444 IF( jl == 8) WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) ! y gent velocity for tracer445 IF( jl == 9) WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) ! z gent velocity for tracer420 IF( jl == jptrc_xei) WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) 421 IF( jl == jptrc_yei) WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 422 IF( jl == jptrc_zei) WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 446 423 # endif 447 424 # if defined key_trcdmp 448 IF( jl == jp diatrc - 1 ) WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) ! damping449 # endif 450 IF( jl == jp diatrc ) WRITE (cltra,'("SBC_",a)') ctrcnm(jn) ! surface boundary conditions425 IF( jl == jptrc_dmp ) WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 426 # endif 427 IF( jl == jptrc_sbc ) WRITE (cltra,'("SBC_",16a)') ctrcnm(jn) 451 428 ! 452 CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ik eep(jn),jl),ndimt50, ndext50)429 CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ikn,jl),ndimt50, ndext50) 453 430 END DO 454 431 END IF 455 432 END DO 433 434 ! synchronise FILE 435 IF( MOD( kt, nwritetrd ) == 0 .OR. kindic < 0 ) THEN 436 DO jn = 1, jptra 437 IF (luttrd(jn)) CALL histsync( nit6(jn) ) 438 END DO 439 ENDIF 456 440 457 441 ! Closing all files … … 463 447 ENDIF 464 448 ! 465 466 449 END SUBROUTINE trcdid_wr 467 450 … … 486 469 !! 487 470 !! At each time step call histdef to compute the mean if necessary 488 !! Each nwrite diatime step, output the instantaneous or mean fields471 !! Each nwritetrc time step, output the instantaneous or mean fields 489 472 !! 490 473 !! IF kindic <0, output of fields before the model interruption. … … 499 482 CHARACTER (len=20) :: cltra, cltrau 500 483 CHARACTER (len=80) :: cltral 501 INTEGER :: j l502 INTEGER :: iimi, iima, ijmi, ijma, ipk, it , itmod484 INTEGER :: jn 485 INTEGER :: iimi, iima, ijmi, ijma, ipk, it 503 486 REAL(wp) :: zsto, zout, zdt 504 487 !!---------------------------------------------------------------------- … … 506 489 ! Initialisation 507 490 ! -------------- 508 491 509 492 ! local variable for debugging 510 493 ll_print = .FALSE. … … 513 496 ! Define frequency of output and means 514 497 zdt = rdt 515 IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!)516 ELSE ; clop = "x" ! no use of the mask value (require less cpu time)517 ENDIF518 498 # if defined key_diainstant 519 zsto = nwritedia *zdt520 clop = "inst("//TRIM(clop)//")"499 zsto=nwritedia*zdt 500 clop='inst(only(x))' 521 501 # else 522 zsto =zdt523 clop = "ave("//TRIM(clop)//")"502 zsto=zdt 503 clop='ave(only(x))' 524 504 # endif 525 zout = nwritedia *zdt505 zout=nwritedia*zdt 526 506 527 507 ! Define indices of the horizontal output zoom and vertical limit storage … … 531 511 532 512 ! define time axis 533 itmod = kt - nittrc000 + 1 534 it = kt 513 it = kt - nittrc000 + 1 535 514 536 515 ! 1. Define NETCDF files and fields at beginning of first time step … … 545 524 ! Define the T grid file for tracer auxiliary files 546 525 547 CALL dia_nam( clhstnam, nwrite dia, 'diad_T' )526 CALL dia_nam( clhstnam, nwrite, 'diad_T' ) 548 527 IF(lwp) WRITE(numout,*) " Name of NETCDF file ", clhstnam 549 528 … … 552 531 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 553 532 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 554 & nittrc000-ndttrc, xjulian, zdt, nhoritd, nitd , domain_id=nidom )533 & 0, zjulian, zdt, nhoritd, nitd , domain_id=nidom ) 555 534 556 535 ! Vertical grid for 2d and 3d arrays 557 536 558 CALL histvert( nitd, 'deptht', 'Vertical T levels','m', ipk, gdept_0, ndepitd) 537 CALL histvert( nitd, 'deptht', 'Vertical T levels', & 538 & 'm', ipk, gdept_0, ndepitd) 559 539 560 540 ! Declare all the output fields as NETCDF variables 561 541 562 542 ! more 3D horizontal arrays 563 DO j l= 1, jpdia3d564 cltra = ctrc3d(j l) ! short title for 3D diagnostic565 cltral = ctrc3l(j l) ! long title for 3D diagnostic566 cltrau = ctrc3u(j l) ! UNIT for 3D diagnostic543 DO jn = 1, jpdia3d 544 cltra = ctrc3d(jn) ! short title for 3D diagnostic 545 cltral = ctrc3l(jn) ! long title for 3D diagnostic 546 cltrau = ctrc3u(jn) ! UNIT for 3D diagnostic 567 547 CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd, & 568 548 & ipk, 1, ipk, ndepitd, 32, clop, zsto, zout ) … … 570 550 571 551 ! more 2D horizontal arrays 572 DO j l= 1, jpdia2d573 cltra = ctrc2d(j l) ! short title for 2D diagnostic574 cltral = ctrc2l(j l) ! long title for 2D diagnostic575 cltrau = ctrc2u(j l) ! UNIT for 2D diagnostic552 DO jn = 1, jpdia2d 553 cltra = ctrc2d(jn) ! short title for 2D diagnostic 554 cltral = ctrc2l(jn) ! long title for 2D diagnostic 555 cltrau = ctrc2u(jn) ! UNIT for 2D diagnostic 576 556 CALL histdef( nitd, cltra, cltral, cltrau, jpi, jpj, nhoritd, & 577 557 & 1, 1, 1, -99, 32, clop, zsto, zout ) … … 592 572 ! --------------------- 593 573 594 IF( lwp .AND. MOD( itmod, nwritedia ) == 0 ) THEN574 IF( lwp .AND. MOD( kt, nwritedia ) == 0 ) THEN 595 575 WRITE(numout,*) 'trcdii_wr : write NetCDF additional arrays at ', kt, 'time-step' 596 576 WRITE(numout,*) '~~~~~~ ' … … 598 578 599 579 ! more 3D horizontal arrays 600 DO j l= 1, jpdia3d601 cltra = ctrc3d(j l) ! short title for 3D diagnostic602 CALL histwrite( nitd, cltra, it, trc3d(:,:,:,j l), ndimt50 ,ndext50)580 DO jn = 1, jpdia3d 581 cltra = ctrc3d(jn) ! short title for 3D diagnostic 582 CALL histwrite( nitd, cltra, it, trc3d(:,:,:,jn), ndimt50 ,ndext50) 603 583 END DO 604 584 605 585 ! more 2D horizontal arrays 606 DO j l= 1, jpdia2d607 cltra = ctrc2d(j l) ! short title for 2D diagnostic608 CALL histwrite(nitd, cltra, it, trc2d(:,:,j l), ndimt51 ,ndext51)586 DO jn = 1, jpdia2d 587 cltra = ctrc2d(jn) ! short title for 2D diagnostic 588 CALL histwrite(nitd, cltra, it, trc2d(:,:,jn), ndimt51 ,ndext51) 609 589 END DO 590 591 ! synchronise FILE 592 IF( MOD( kt, nwritedia ) == 0 .OR. kindic < 0 ) CALL histsync( nitd ) 610 593 611 594 ! Closing all files … … 613 596 IF( kt == nitend .OR. kindic < 0 ) CALL histclo(nitd) 614 597 ! 615 616 598 END SUBROUTINE trcdii_wr 617 599 … … 636 618 !! 637 619 !! At each time step call histdef to compute the mean if necessary 638 !! Each nwrite biotime step, output the instantaneous or mean fields620 !! Each nwritetrc time step, output the instantaneous or mean fields 639 621 !! 640 622 !! IF kindic <0, output of fields before the model interruption. … … 650 632 CHARACTER (len=20) :: cltra, cltrau 651 633 CHARACTER (len=80) :: cltral 652 INTEGER :: ji, jj, jk, j l653 INTEGER :: iimi, iima, ijmi, ijma, ipk, it , itmod634 INTEGER :: ji, jj, jk, jn 635 INTEGER :: iimi, iima, ijmi, ijma, ipk, it 654 636 REAL(wp) :: zsto, zout, zdt 655 637 !!---------------------------------------------------------------------- … … 658 640 ! -------------- 659 641 660 661 642 ! local variable for debugging 662 643 ll_print = .FALSE. … … 665 646 ! Define frequency of output and means 666 647 zdt = rdt 667 IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!)668 ELSE ; clop = "x" ! no use of the mask value (require less cpu time)669 ENDIF670 648 # if defined key_diainstant 671 zsto = nwritebio *zdt672 clop = "inst("//TRIM(clop)//")"649 zsto=nwritebio*zdt 650 clop='inst(only(x))' 673 651 # else 674 zsto =zdt675 clop = "ave("//TRIM(clop)//")"652 zsto=zdt 653 clop='ave(only(x))' 676 654 # endif 677 zout = nwritebio *zdt678 679 ! Define indices of the horizontal output zoom and vertical limit storage 655 zout=nwritebio*zdt 656 657 ! Define indices of the horizontal output zoom and vertical limit storage iimi = 1 ; iima = jpi 680 658 iimi = 1 ; iima = jpi 681 659 ijmi = 1 ; ijma = jpj … … 683 661 684 662 ! define time axis 685 itmod = kt - nittrc000 + 1 686 it = kt 663 it = kt - nittrc000 + 1 687 664 688 665 ! Define NETCDF files and fields at beginning of first time step … … 695 672 ! Define the NETCDF files for biological trends 696 673 697 CALL dia_nam(clhstnam,nwrite bio,'biolog')674 CALL dia_nam(clhstnam,nwrite,'biolog') 698 675 IF(lwp)WRITE(numout,*) " Name of NETCDF file for biological trends ", clhstnam 699 676 ! Horizontal grid : glamt and gphit 700 CALL histbeg( 677 CALL histbeg(clhstnam, jpi, glamt, jpj, gphit, & 701 678 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 702 & nittrc000-ndttrc, xjulian, zdt, nhoritb, nitb , domain_id=nidom)679 & 0, zjulian, rdt, nhoritb, nitb , domain_id=nidom) 703 680 ! Vertical grid for biological trends 704 CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepitb) 681 CALL histvert(nitb, 'deptht', 'Vertical T levels', & 682 & 'm', ipk, gdept_0, ndepitb) 705 683 706 684 ! Declare all the output fields as NETCDF variables 707 685 ! biological trends 708 DO j l= 1, jpdiabio709 cltra = ctrbio(j l) ! short title for biological diagnostic710 cltral = ctrbil(j l) ! long title for biological diagnostic711 cltrau = ctrbiu(j l) ! UNIT for biological diagnostic712 CALL histdef( 686 DO jn = 1, jpdiabio 687 cltra = ctrbio(jn) ! short title for biological diagnostic 688 cltral = ctrbil(jn) ! long title for biological diagnostic 689 cltrau = ctrbiu(jn) ! UNIT for biological diagnostic 690 CALL histdef(nitb, cltra, cltral, cltrau, jpi, jpj, nhoritb, & 713 691 & ipk, 1, ipk, ndepitb, 32, clop, zsto, zout) 714 692 END DO 715 693 716 694 ! CLOSE netcdf Files 717 CALL histend( nitb)695 CALL histend(nitb) 718 696 719 697 IF(lwp) WRITE(numout,*) … … 727 705 728 706 ! biological trends 729 IF( lwp .AND. MOD( itmod, nwritebio ) == 0 ) THEN707 IF( lwp .AND. MOD( kt, nwritebio ) == 0 ) THEN 730 708 WRITE(numout,*) 'trcdit_wr : write NetCDF biological trends at ', kt, 'time-step' 731 709 WRITE(numout,*) '~~~~~~ ' 732 710 ENDIF 733 711 734 DO j l= 1, jpdiabio735 cltra = ctrbio(jl) ! short title for biological diagnostic736 CALL histwrite(nitb, cltra, it, trbio(:,:,:,j l), ndimt50,ndext50)712 DO jn = 1, jpdiabio 713 cltra=ctrbio(jn) ! short title for biological diagnostic 714 CALL histwrite(nitb, cltra, it, trbio(:,:,:,jn), ndimt50,ndext50) 737 715 END DO 716 717 ! synchronise FILE 718 IF( MOD( kt, nwritebio ) == 0 .OR. kindic < 0 ) CALL histsync( nitb ) 738 719 739 720 ! Closing all files … … 741 722 IF( kt == nitend .OR. kindic < 0 ) CALL histclo( nitb ) 742 723 ! 743 744 724 END SUBROUTINE trcdib_wr 745 725 … … 757 737 !!---------------------------------------------------------------------- 758 738 CONTAINS 759 SUBROUTINE trc_dia( kt ) ! Empty routine 739 SUBROUTINE trc_dia( kt ) ! Empty routine 760 740 INTEGER, INTENT(in) :: kt 761 END SUBROUTINE trc_dia 741 END SUBROUTINE trc_dia 762 742 763 743 #endif
Note: See TracChangeset
for help on using the changeset viewer.
