Changeset 2007 for branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/trcdia.F90
- Timestamp:
- 2010-07-13T17:14:39+02:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r1879_FCM/NEMOGCM/NEMO/TOP_SRC/trcdia.F90
r1715 r2007 25 25 USE trc 26 26 USE trp_trc 27 USE par_trc 27 28 USE trdmld_trc_oce, ONLY : luttrd 28 29 USE dianam ! build name of file (routine) … … 41 42 INTEGER :: ndimt50 !: number of ocean points in index array 42 43 INTEGER :: ndimt51 !: number of ocean points in index array 43 REAL(wp) :: xjulian !: ???? not DOCTOR !44 REAL(wp) :: zjulian !: ???? not DOCTOR ! 44 45 INTEGER , DIMENSION (jpij*jpk) :: ndext50 !: integer arrays for ocean 3D index 45 46 INTEGER , DIMENSION (jpij) :: ndext51 !: integer arrays for ocean surface index … … 157 158 158 159 ! 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 experiment160 CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) 161 zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment 161 162 IF(lwp)WRITE(numout,*)' ' 162 163 IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000 & 163 164 & ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday & 164 & ,'Julian day : ', xjulian165 & ,'Julian day : ', zjulian 165 166 166 167 IF(lwp) WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma, & … … 171 172 IF(lwp) THEN 172 173 CALL dia_nam( clhstnam, nwritetrc,' ' ) 173 CALL ctl _opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )174 CALL ctlopn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, narea ) 174 175 WRITE(inum,*) clhstnam 175 176 CLOSE(inum) … … 184 185 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 185 186 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 186 & nittrc000-ndttrc, xjulian, zdt, nhorit5, nit5 , domain_id=nidom)187 & nittrc000-ndttrc, zjulian, zdt, nhorit5, nit5 , domain_id=nidom) 187 188 188 189 ! Vertical grid for tracer : gdept … … 258 259 CHARACTER (len=80) :: cltral 259 260 CHARACTER (len=10) :: csuff 260 INTEGER :: jn, jl 261 INTEGER :: jn, jl, ikn 261 262 INTEGER :: iimi, iima, ijmi, ijma, ipk, it, itmod 262 263 REAL(wp) :: zsto, zout, zdt … … 313 314 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 314 315 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 315 & nittrc000-ndttrc, xjulian, zdt, nhorit6(jn), &316 & nittrc000-ndttrc, zjulian, zdt, nhorit6(jn), & 316 317 & nit6(jn) , domain_id=nidom ) 317 318 … … 322 323 323 324 ! Declare all the output fields as NETCDF variables 324 325 ! trends for tracer concentrations326 325 DO jn = 1, jptra 327 326 IF( luttrd(jn) ) THEN 328 327 DO jl = 1, jpdiatrc 329 IF( jl == 1) THEN328 IF( jl == jptrc_xad ) THEN 330 329 ! short and long title for x advection for tracer 331 330 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 331 WRITE (cltral,'("X advective trend for ",58a)') ctrcnl(jn)(1:58) 332 END IF 333 IF( jl == jptrc_yad ) THEN 336 334 ! short and long title for y advection for tracer 337 335 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 336 WRITE (cltral,'("Y advective trend for ",58a)') ctrcnl(jn)(1:58) 337 END IF 338 IF( jl == jptrc_zad ) THEN 342 339 ! short and long title for Z advection for tracer 343 340 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 341 WRITE (cltral,'("Z advective trend for ",58a)') ctrcnl(jn)(1:58) 342 END IF 343 IF( jl == jptrc_xdf ) THEN 348 344 ! short and long title for X diffusion for tracer 349 345 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 346 WRITE (cltral,'("X diffusion trend for ",58a)') ctrcnl(jn)(1:58) 347 END IF 348 IF( jl == jptrc_ydf ) THEN 354 349 ! short and long title for Y diffusion for tracer 355 350 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 351 WRITE (cltral,'("Y diffusion trend for ",58a)') ctrcnl(jn)(1:58) 352 END IF 353 IF( jl == jptrc_zdf ) THEN 360 354 ! short and long title for Z diffusion for tracer 361 355 WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 362 WRITE (cltral,'("Z diffusion trend for ",58a)') & 363 & ctrcnl(jn)(1:58) 356 WRITE (cltral,'("Z diffusion trend for ",58a)') ctrcnl(jn)(1:58) 364 357 END IF 365 358 # if defined key_trcldf_eiv 366 IF( jl == 7) THEN359 IF( jl == jptrc_xei ) THEN 367 360 ! short and long title for x gent velocity for tracer 368 361 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 362 WRITE (cltral,'("X gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 363 END IF 364 IF( jl == jptrc_yei ) THEN 373 365 ! short and long title for y gent velocity for tracer 374 366 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 367 WRITE (cltral,'("Y gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 368 END IF 369 IF( jl == jptrc_zei ) THEN 379 370 ! short and long title for Z gent velocity for tracer 380 371 WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 381 WRITE (cltral,'("Z gent velocity trend for ",53a)') & 382 & ctrcnl(jn)(1:53) 372 WRITE (cltral,'("Z gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 383 373 END IF 384 374 # endif 385 375 # if defined key_trcdmp 386 IF( jl == jp diatrc - 1) THEN376 IF( jl == jptrc_dmp ) THEN 387 377 ! last trends for tracer damping : short and long title 388 378 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 379 WRITE (cltral,'("Tracer damping trend for ",55a)') ctrcnl(jn)(1:55) 380 END IF 381 # endif 382 IF( jl == jptrc_sbc ) THEN 394 383 ! last trends for tracer damping : short and long title 395 384 WRITE (cltra,'("SBC_",16a)') ctrcnm(jn) 396 WRITE (cltral,'("Surface boundary flux ",58a)') &397 & ctrcnl(jn)(1:58)398 END IF399 385 WRITE (cltral,'("Surface boundary flux ",58a)') ctrcnl(jn)(1:55) 386 END IF 387 WRITE (cltral,'("Surface boundary flux ",58a)') ctrcnl(jn)(1:55) 388 END IF 400 389 CALL FLUSH( numout ) 401 390 cltrau = ctrcun(jn) ! UNIT for tracer /trends … … 406 395 END IF 407 396 END DO 408 409 397 ! CLOSE netcdf Files 410 398 DO jn = 1, jptra … … 432 420 DO jn = 1, jptra 433 421 IF( luttrd(jn) ) THEN 422 ikn = ikeep(jn) 434 423 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 tracer424 ! short titles 425 IF( jl == jptrc_xad) WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 426 IF( jl == jptrc_yad) WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 427 IF( jl == jptrc_zad) WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 428 IF( jl == jptrc_xdf) WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 429 IF( jl == jptrc_ydf) WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 430 IF( jl == jptrc_zdf) WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 442 431 # 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 tracer432 IF( jl == jptrc_xei) WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) 433 IF( jl == jptrc_yei) WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 434 IF( jl == jptrc_zei) WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 446 435 # endif 447 436 # 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 conditions437 IF( jl == jptrc_dmp ) WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 438 # endif 439 IF( jl == jptrc_sbc ) WRITE (cltra,'("SBC_",16a)') ctrcnm(jn) 451 440 ! 452 CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ik eep(jn),jl),ndimt50, ndext50)441 CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ikn,jl),ndimt50, ndext50) 453 442 END DO 454 443 END IF … … 552 541 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 553 542 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 554 & nittrc000-ndttrc, xjulian, zdt, nhoritd, nitd , domain_id=nidom )543 & nittrc000-ndttrc, zjulian, zdt, nhoritd, nitd , domain_id=nidom ) 555 544 556 545 ! Vertical grid for 2d and 3d arrays … … 700 689 CALL histbeg( clhstnam, jpi, glamt, jpj, gphit, & 701 690 & iimi, iima-iimi+1, ijmi, ijma-ijmi+1, & 702 & nittrc000-ndttrc, xjulian, zdt, nhoritb, nitb , domain_id=nidom )691 & nittrc000-ndttrc, zjulian, zdt, nhoritb, nitb , domain_id=nidom ) 703 692 ! Vertical grid for biological trends 704 693 CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepitb)
Note: See TracChangeset
for help on using the changeset viewer.
