Changeset 9124 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA
- Timestamp:
- 2017-12-19T09:26:25+01:00 (6 years ago)
- Location:
- branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA
- Files:
-
- 9 edited
-
diaar5.F90 (modified) (5 diffs)
-
diacfl.F90 (modified) (2 diffs)
-
diadct.F90 (modified) (13 diffs)
-
diaharm.F90 (modified) (8 diffs)
-
diahsb.F90 (modified) (3 diffs)
-
diahth.F90 (modified) (2 diffs)
-
diaptr.F90 (modified) (4 diffs)
-
diatmb.F90 (modified) (5 diffs)
-
diawri.F90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r9019 r9124 13 13 USE dom_oce ! ocean space and time domain 14 14 USE eosbn2 ! equation of state (eos_bn2 routine) 15 USE lib_mpp ! distribued memory computing library16 USE iom ! I/O manager library17 USE timing ! preformance summary18 USE wrk_nemo ! working arrays19 USE fldread ! type FLD_N20 15 USE phycst ! physical constant 21 16 USE in_out_manager ! I/O manager 22 17 USE zdfddm 23 18 USE zdf_oce 19 ! 20 USE lib_mpp ! distribued memory computing library 21 USE iom ! I/O manager library 22 USE fldread ! type FLD_N 23 USE timing ! preformance summary 24 USE wrk_nemo ! working arrays 24 25 25 26 IMPLICIT NONE … … 80 81 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace 81 82 !!-------------------------------------------------------------------- 82 IF( nn_timing == 1) CALL timing_start('dia_ar5')83 IF( ln_timing ) CALL timing_start('dia_ar5') 83 84 84 85 IF( kt == nit000 ) CALL dia_ar5_init … … 255 256 ENDIF 256 257 ! 257 IF( nn_timing == 1) CALL timing_stop('dia_ar5')258 IF( ln_timing ) CALL timing_stop('dia_ar5') 258 259 ! 259 260 END SUBROUTINE dia_ar5 261 260 262 261 263 SUBROUTINE dia_ar5_hst( ktra, cptr, pua, pva ) … … 332 334 !!---------------------------------------------------------------------- 333 335 ! 334 IF( nn_timing == 1 ) CALL timing_start('dia_ar5_init')335 !336 336 l_ar5 = .FALSE. 337 337 IF( iom_use( 'voltot' ) .OR. iom_use( 'sshtot' ) .OR. iom_use( 'sshdyn' ) .OR. & … … 380 380 ENDIF 381 381 ! 382 IF( nn_timing == 1 ) CALL timing_stop('dia_ar5_init')383 !384 382 END SUBROUTINE dia_ar5_init 385 383 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diacfl.F90
r9019 r9124 60 60 !!---------------------------------------------------------------------- 61 61 ! 62 IF( nn_timing == 1) CALL timing_start('dia_cfl')62 IF( ln_timing ) CALL timing_start('dia_cfl') 63 63 ! 64 64 ! ! setup timestep multiplier to account for initial Eulerian timestep … … 138 138 ENDIF 139 139 ! 140 IF( nn_timing == 1) CALL timing_stop('dia_cfl')140 IF( ln_timing ) CALL timing_stop('dia_cfl') 141 141 ! 142 142 END SUBROUTINE dia_cfl -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r9019 r9124 37 37 USE domvvl 38 38 USE timing ! preformance summary 39 USE wrk_nemo ! working arrays40 39 41 40 IMPLICIT NONE … … 121 120 122 121 123 SUBROUTINE dia_dct_init124 !!---------------------------------------------------------------------125 !! *** ROUTINE diadct ***126 !!127 !! ** Purpose: Read the namelist parameters128 !! Open output files129 !!130 !!---------------------------------------------------------------------131 NAMELIST/namdct/nn_dct,nn_dctwri,nn_secdebug132 INTEGER :: ios ! Local integer output status for namelist read133 134 IF( nn_timing == 1 ) CALL timing_start('dia_dct_init')122 SUBROUTINE dia_dct_init 123 !!--------------------------------------------------------------------- 124 !! *** ROUTINE diadct *** 125 !! 126 !! ** Purpose: Read the namelist parameters 127 !! Open output files 128 !! 129 !!--------------------------------------------------------------------- 130 INTEGER :: ios ! Local integer output status for namelist read 131 !! 132 NAMELIST/namdct/nn_dct,nn_dctwri,nn_secdebug 133 !!--------------------------------------------------------------------- 135 134 136 135 REWIND( numnam_ref ) ! Namelist namdct in reference namelist : Diagnostic: transport through sections … … 140 139 REWIND( numnam_cfg ) ! Namelist namdct in configuration namelist : Diagnostic: transport through sections 141 140 READ ( numnam_cfg, namdct, IOSTAT = ios, ERR = 902 ) 142 902 IF( ios /=0 ) CALL ctl_nam ( ios , 'namdct in configuration namelist', lwp )141 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdct in configuration namelist', lwp ) 143 142 IF(lwm) WRITE ( numond, namdct ) 144 143 … … 175 174 transports_3d(:,:,:,:)=0.0 176 175 transports_2d(:,:,:) =0.0 177 178 IF( nn_timing == 1 ) CALL timing_stop('dia_dct_init')179 176 ! 180 177 END SUBROUTINE dia_dct_init 181 178 182 179 183 SUBROUTINE dia_dct( kt)180 SUBROUTINE dia_dct( kt ) 184 181 !!--------------------------------------------------------------------- 185 182 !! *** ROUTINE diadct *** … … 198 195 !! Reinitialise all relevant arrays to zero 199 196 !!--------------------------------------------------------------------- 200 INTEGER, INTENT(in) ::kt197 INTEGER, INTENT(in) :: kt 201 198 ! 202 INTEGER :: jsec, &! loop on sections 203 itotal ! nb_sec_max*nb_type_class*nb_class_max 204 LOGICAL :: lldebug =.FALSE. ! debug a section 205 206 INTEGER , DIMENSION(1) :: ish ! tmp array for mpp_sum 207 INTEGER , DIMENSION(3) :: ish2 ! " 208 REAL(wp), POINTER, DIMENSION(:) :: zwork ! " 209 REAL(wp), POINTER, DIMENSION(:,:,:):: zsum ! " 199 INTEGER :: jsec ! loop on sections 200 INTEGER :: itotal ! nb_sec_max*nb_type_class*nb_class_max 201 LOGICAL :: lldebug =.FALSE. ! debug a section 202 INTEGER , DIMENSION(1) :: ish ! work array for mpp_sum 203 INTEGER , DIMENSION(3) :: ish2 ! " 204 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zwork ! " 205 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:):: zsum ! " 210 206 !!--------------------------------------------------------------------- 211 207 ! 212 IF( nn_timing == 1) CALL timing_start('dia_dct')208 IF( ln_timing ) CALL timing_start('dia_dct') 213 209 214 210 IF( lk_mpp )THEN 215 211 itotal = nb_sec_max*nb_type_class*nb_class_max 216 CALL wrk_alloc( itotal , zwork ) 217 CALL wrk_alloc( nb_sec_max,nb_type_class,nb_class_max , zsum ) 212 ALLOCATE( zwork(itotal) , zsum(nb_sec_max,nb_type_class,nb_class_max) ) 218 213 ENDIF 219 214 … … 286 281 IF( lk_mpp )THEN 287 282 itotal = nb_sec_max*nb_type_class*nb_class_max 288 CALL wrk_dealloc( itotal , zwork ) 289 CALL wrk_dealloc( nb_sec_max,nb_type_class,nb_class_max , zsum ) 283 DEALLOCATE( zwork , zsum ) 290 284 ENDIF 291 285 292 IF( nn_timing == 1) CALL timing_stop('dia_dct')286 IF( ln_timing ) CALL timing_stop('dia_dct') 293 287 ! 294 288 END SUBROUTINE dia_dct 289 295 290 296 291 SUBROUTINE readsec … … 304 299 !! 305 300 !!--------------------------------------------------------------------- 306 !! * Local variables307 301 INTEGER :: iptglo , iptloc ! Global and local number of points for a section 308 302 INTEGER :: isec, iiglo, ijglo, iiloc, ijloc,iost,i1 ,i2 ! temporary integer 309 303 INTEGER :: jsec, jpt ! dummy loop indices 310 311 304 INTEGER, DIMENSION(2) :: icoord 312 CHARACTER(len=160) :: clname !filename 305 LOGICAL :: llbon, lldebug ! local logical 306 CHARACTER(len=160) :: clname ! filename 313 307 CHARACTER(len=200) :: cltmp 314 CHARACTER(len=200) :: clformat !automatic format 315 TYPE(POINT_SECTION),DIMENSION(nb_point_max) ::coordtemp !contains listpoints coordinates 316 !read in the file 317 INTEGER, POINTER, DIMENSION(:) :: directemp !contains listpoints directions 318 !read in the files 319 LOGICAL :: llbon ,&!local logical 320 lldebug !debug the section 308 CHARACTER(len=200) :: clformat !automatic format 309 TYPE(POINT_SECTION),DIMENSION(nb_point_max) ::coordtemp !contains listpoints coordinates read in the file 310 INTEGER, DIMENSION(nb_point_max) :: directemp !contains listpoints directions read in the files 321 311 !!------------------------------------------------------------------------------------- 322 CALL wrk_alloc( nb_point_max, directemp )323 312 324 313 !open input file … … 491 480 492 481 nb_sec = jsec-1 !number of section read in the file 493 494 CALL wrk_dealloc( nb_point_max, directemp )495 482 ! 496 483 END SUBROUTINE readsec 484 497 485 498 486 SUBROUTINE removepoints(sec,cdind,cdextr,ld_debug) … … 518 506 istart,iend !first and last points selected in listpoint 519 507 INTEGER :: jpoint !loop on list points 520 INTEGER, POINTER, DIMENSION( :) :: idirec !contains temporary sec%direction521 INTEGER, POINTER, DIMENSION( :,:) :: icoord !contains temporary sec%listpoint508 INTEGER, POINTER, DIMENSION(nb_point_max) :: idirec !contains temporary sec%direction 509 INTEGER, POINTER, DIMENSION(2,nb_point_max) :: icoord !contains temporary sec%listpoint 522 510 !---------------------------------------------------------------------------- 523 CALL wrk_alloc( nb_point_max, idirec ) 524 CALL wrk_alloc( 2, nb_point_max, icoord ) 525 511 ! 526 512 IF( ld_debug )WRITE(numout,*)' -------------------------' 527 513 IF( ld_debug )WRITE(numout,*)' removepoints in listpoint' … … 571 557 WRITE(numout,*)' sec%direction after removepoints :',sec%direction(1:sec%nb_point) 572 558 ENDIF 573 574 CALL wrk_dealloc( nb_point_max, idirec ) 575 CALL wrk_dealloc( 2, nb_point_max, icoord ) 576 END SUBROUTINE removepoints 577 578 SUBROUTINE transport(sec,ld_debug,jsec) 559 ! 560 END SUBROUTINE removepoints 561 562 SUBROUTINE transport(sec,ld_debug,jsec) 579 563 !!------------------------------------------------------------------------------------------- 580 564 !! *** ROUTINE transport *** … … 596 580 !! 597 581 !!------------------------------------------------------------------------------------------- 598 !! * Arguments599 582 TYPE(SECTION),INTENT(INOUT) :: sec 600 583 LOGICAL ,INTENT(IN) :: ld_debug 601 584 INTEGER ,INTENT(IN) :: jsec ! numeric identifier of section 602 603 !! * Local variables 604 INTEGER :: jk, jseg, jclass,jl, &!loop on level/segment/classes/ice categories 605 isgnu, isgnv ! 606 REAL(wp) :: zumid, zvmid, &!U/V velocity on a cell segment 607 zumid_ice, zvmid_ice, &!U/V ice velocity 608 zTnorm !transport of velocity through one cell's sides 609 REAL(wp) :: ztn, zsn, zrhoi, zrhop, zsshn, zdep !temperature/salinity/potential density/ssh/depth at u/v point 610 611 TYPE(POINT_SECTION) :: k 585 ! 586 INTEGER :: jk, jseg, jclass,jl, isgnu, isgnv ! loop on level/segment/classes/ice categories 587 REAL(wp):: zumid, zvmid, zumid_ice, zvmid_ice ! U/V ocean & ice velocity on a cell segment 588 REAL(wp):: zTnorm ! transport of velocity through one cell's sides 589 REAL(wp):: ztn, zsn, zrhoi, zrhop, zsshn, zdep ! temperature/salinity/potential density/ssh/depth at u/v point 590 TYPE(POINT_SECTION) :: k 612 591 !!-------------------------------------------------------- 613 592 ! … … 1008 987 REAL(wp) :: zslope ! section's slope coeff 1009 988 ! 1010 REAL(wp), POINTER, DIMENSION(:):: zsumclasses! 1D workspace989 REAL(wp), DIMENSION(nb_type_class):: zsumclasses ! 1D workspace 1011 990 !!------------------------------------------------------------- 1012 CALL wrk_alloc(nb_type_class , zsumclasses )1013 991 1014 992 zsumclasses(:)=0._wp … … 1121 1099 118 FORMAT(I8,1X,I8,1X,I4,1X,A30,1X,f9.2,1X,I4,3X,A8,1X,2F12.4,5X,3F12.4) 1122 1100 119 FORMAT(I8,1X,I8,1X,I4,1X,A30,1X,f9.2,1X,I4,3X,A8,1X,2F12.4,5X,3E15.6) 1123 1124 CALL wrk_dealloc(nb_type_class , zsumclasses )1125 1101 ! 1126 1102 END SUBROUTINE dia_dct_wri -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diaharm.F90
r7646 r9124 22 22 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 23 23 USE timing ! preformance summary 24 USE wrk_nemo ! working arrays25 24 26 25 IMPLICIT NONE … … 177 176 REAL(wp) :: ztime, ztemp 178 177 !!-------------------------------------------------------------------- 179 IF( nn_timing == 1) CALL timing_start('dia_harm')180 181 IF( kt == nit000 ) CALL dia_harm_init182 178 IF( ln_timing ) CALL timing_start('dia_harm') 179 ! 180 IF( kt == nit000 ) CALL dia_harm_init 181 ! 183 182 IF( kt >= nit000_han .AND. kt <= nitend_han .AND. MOD(kt,nstep_han) == 0 ) THEN 184 183 ! 185 184 ztime = (kt-nit000+1) * rdt 186 185 ! 187 186 nhc = 0 188 187 DO jh = 1, nb_ana … … 191 190 ztemp =( MOD(jc,2) * ft(jh) *COS(ana_freq(jh)*ztime + vt(jh) + ut(jh)) & 192 191 & +(1.-MOD(jc,2))* ft(jh) *SIN(ana_freq(jh)*ztime + vt(jh) + ut(jh))) 193 192 ! 194 193 DO jj = 1,jpj 195 194 DO ji = 1,jpi … … 205 204 ! 206 205 END IF 207 208 IF 209 210 IF( nn_timing == 1) CALL timing_stop('dia_harm')211 206 ! 207 IF( kt == nitend_han ) CALL dia_harm_end 208 ! 209 IF( ln_timing ) CALL timing_stop('dia_harm') 210 ! 212 211 END SUBROUTINE dia_harm 213 212 … … 225 224 INTEGER :: ksp, kun, keq 226 225 REAL(wp) :: ztime, ztime_ini, ztime_end 227 REAL(wp) :: X1,X2 228 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ana_amp 229 !!-------------------------------------------------------------------- 230 CALL wrk_alloc( jpi , jpj , jpmax_harmo , 2 , ana_amp ) 231 226 REAL(wp) :: X1, X2 227 REAL(wp), DIMENSION(jpi,jpj,jpmax_harmo,2) :: ana_amp ! workspace 228 !!-------------------------------------------------------------------- 229 ! 232 230 IF(lwp) WRITE(numout,*) 233 231 IF(lwp) WRITE(numout,*) 'anharmo_end: kt=nitend_han: Perform harmonic analysis' … … 364 362 END DO 365 363 END DO 366 364 ! 367 365 CALL dia_wri_harm ! Write results in files 368 CALL wrk_dealloc( jpi , jpj , jpmax_harmo , 2 , ana_amp )369 366 ! 370 367 END SUBROUTINE dia_harm_end … … 427 424 INTEGER :: ji_sd, jj_sd, ji1_sd, ji2_sd, jk1_sd, jk2_sd 428 425 REAL(wp) :: zval1, zval2, zx1 429 REAL(wp), POINTER, DIMENSION(:) :: ztmpx, zcol1, zcol2430 INTEGER , POINTER, DIMENSION(:) :: ipos2, ipivot426 REAL(wp), DIMENSION(jpincomax) :: ztmpx, zcol1, zcol2 427 INTEGER , DIMENSION(jpincomax) :: ipos2, ipivot 431 428 !--------------------------------------------------------------------------------- 432 CALL wrk_alloc( jpincomax , ztmpx , zcol1 , zcol2 ) 433 CALL wrk_alloc( jpincomax , ipos2 , ipivot ) 434 429 ! 435 430 IF( init == 1 ) THEN 436 431 IF( nsparse > jpdimsparse ) CALL ctl_stop( 'STOP', 'SUR_DETERMINE : nsparse .GT. jpdimsparse') … … 517 512 ztmp7(ipos1(jj_sd))=ztmpx(jj_sd) 518 513 END DO 519 520 CALL wrk_dealloc( jpincomax , ztmpx , zcol1 , zcol2 )521 CALL wrk_dealloc( jpincomax , ipos2 , ipivot )522 514 ! 523 515 END SUBROUTINE SUR_DETERMINE -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r7753 r9124 31 31 USE lib_mpp ! distributed memory computing library 32 32 USE timing ! preformance summary 33 USE wrk_nemo ! work arrays34 33 35 34 IMPLICIT NONE … … 82 81 REAL(wp) :: z_wn_trd_t , z_wn_trd_s ! - - 83 82 REAL(wp) :: z_ssh_hc , z_ssh_sc ! - - 84 REAL(wp), DIMENSION(:,:), POINTER :: z2d0, z2d1 85 !!--------------------------------------------------------------------------- 86 IF( nn_timing == 1 ) CALL timing_start('dia_hsb') 87 ! 88 CALL wrk_alloc( jpi,jpj, z2d0, z2d1 ) 83 REAL(wp), DIMENSION(jpi,jpj) :: z2d0, z2d1 ! 2D workspace 84 !!--------------------------------------------------------------------------- 85 IF( ln_timing ) CALL timing_start('dia_hsb') 89 86 ! 90 87 tsn(:,:,:,1) = tsn(:,:,:,1) * tmask(:,:,:) ; tsb(:,:,:,1) = tsb(:,:,:,1) * tmask(:,:,:) ; … … 228 225 IF( lrst_oce ) CALL dia_hsb_rst( kt, 'WRITE' ) 229 226 ! 230 CALL wrk_dealloc( jpi,jpj, z2d0, z2d1 ) 231 ! 232 IF( nn_timing == 1 ) CALL timing_stop('dia_hsb') 227 IF( ln_timing ) CALL timing_stop('dia_hsb') 233 228 ! 234 229 END SUBROUTINE dia_hsb -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90
r9019 r9124 104 104 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: zdelr ! delta rho equivalent to deltaT = 0.2 105 105 !!---------------------------------------------------------------------- 106 IF( nn_timing == 1) CALL timing_start('dia_hth')106 IF( ln_timing ) CALL timing_start('dia_hth') 107 107 108 108 IF( kt == nit000 ) THEN … … 332 332 CALL iom_put( "hc300", htc3 ) ! first 300m heat content 333 333 ! 334 IF( nn_timing == 1) CALL timing_stop('dia_hth')334 IF( ln_timing ) CALL timing_stop('dia_hth') 335 335 ! 336 336 END SUBROUTINE dia_hth -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r9019 r9124 37 37 PUBLIC ptr_sj ! call by tra_ldf & tra_adv routines 38 38 PUBLIC ptr_sjk ! 39 PUBLIC dia_ptr_init ! call in step module39 PUBLIC dia_ptr_init ! call in memogcm 40 40 PUBLIC dia_ptr ! call in step module 41 41 PUBLIC dia_ptr_hst ! called from tra_ldf/tra_adv routines … … 96 96 !!---------------------------------------------------------------------- 97 97 ! 98 IF( nn_timing == 1) CALL timing_start('dia_ptr')98 IF( ln_timing ) CALL timing_start('dia_ptr') 99 99 100 100 ! … … 373 373 ENDIF 374 374 ! 375 IF( nn_timing == 1) CALL timing_stop('dia_ptr')375 IF( ln_timing ) CALL timing_stop('dia_ptr') 376 376 ! 377 377 END SUBROUTINE dia_ptr … … 457 457 ! 458 458 END SUBROUTINE dia_ptr_init 459 459 460 460 461 SUBROUTINE dia_ptr_hst( ktra, cptr, pva ) -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90
r7646 r9124 12 12 USE in_out_manager ! I/O units 13 13 USE iom ! I/0 library 14 USE wrk_nemo ! working arrays15 16 14 17 15 IMPLICIT NONE … … 42 40 !!---------------------------------------------------------------------- 43 41 ! 44 REWIND 45 READ 42 REWIND( numnam_ref ) ! Read Namelist nam_diatmb in reference namelist : TMB diagnostics 43 READ ( numnam_ref, nam_diatmb, IOSTAT=ios, ERR= 901 ) 46 44 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in reference namelist', lwp ) 47 45 48 46 REWIND( numnam_cfg ) ! Namelist nam_diatmb in configuration namelist TMB diagnostics 49 47 READ ( numnam_cfg, nam_diatmb, IOSTAT = ios, ERR = 902 ) 50 902 IF( ios /=0 ) CALL ctl_nam ( ios , 'nam_diatmb in configuration namelist', lwp )48 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nam_diatmb in configuration namelist', lwp ) 51 49 IF(lwm) WRITE ( numond, nam_diatmb ) 52 50 … … 72 70 !! 73 71 !!---------------------------------------------------------------------- 74 REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(in ) :: pfield ! Input 3dfield and mask75 REAL(wp), DIMENSION(jpi, jpj, 3 ), INTENT( out) :: ptmb ! top, middle, bottom extracted from pfield72 REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(in ) :: pfield ! Input 3D field and mask 73 REAL(wp), DIMENSION(jpi, jpj, 3 ), INTENT( out) :: ptmb ! top, middle, bottom extracted from pfield 76 74 ! 77 INTEGER :: ji, jj! Dummy loop indices78 INTEGER :: itop, imid, ibot! local integers79 REAL(wp) :: zmdi = 1.e+20_wp! land value75 INTEGER :: ji, jj ! Dummy loop indices 76 INTEGER :: itop, imid, ibot ! local integers 77 REAL(wp):: zmdi = 1.e+20_wp ! land value 80 78 !!--------------------------------------------------------------------- 81 79 ! … … 86 84 imid = itop + ( ibot - itop + 1 ) / 2 ! middle ocean 87 85 ! 88 ptmb(ji,jj,1) = pfield(ji,jj,itop)*tmask(ji,jj,itop) 89 ptmb(ji,jj,2) = pfield(ji,jj,imid)*tmask(ji,jj,imid) 90 ptmb(ji,jj,3) = pfield(ji,jj,ibot)*tmask(ji,jj,ibot) 86 ptmb(ji,jj,1) = pfield(ji,jj,itop)*tmask(ji,jj,itop) + zmdi*( 1._wp-tmask(ji,jj,itop) ) 87 ptmb(ji,jj,2) = pfield(ji,jj,imid)*tmask(ji,jj,imid) + zmdi*( 1._wp-tmask(ji,jj,imid) ) 88 ptmb(ji,jj,3) = pfield(ji,jj,ibot)*tmask(ji,jj,ibot) + zmdi*( 1._wp-tmask(ji,jj,ibot) ) 91 89 END DO 92 90 END DO … … 105 103 !!-------------------------------------------------------------------- 106 104 REAL(wp) :: zmdi =1.e+20 ! land value 107 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb! workspace105 REAL(wp), DIMENSION(jpi,jpj,3) :: zwtmb ! workspace 108 106 !!-------------------------------------------------------------------- 109 107 ! 110 IF (ln_diatmb) THEN 111 CALL wrk_alloc( jpi,jpj,3 , zwtmb ) 112 CALL dia_calctmb( tsn(:,:,:,jp_tem),zwtmb ) 113 !ssh already output but here we output it masked 114 CALL iom_put( "sshnmasked" , sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) ) 115 CALL iom_put( "top_temp" , zwtmb(:,:,1) ) ! tmb Temperature 116 CALL iom_put( "mid_temp" , zwtmb(:,:,2) ) ! tmb Temperature 117 CALL iom_put( "bot_temp" , zwtmb(:,:,3) ) ! tmb Temperature 118 ! CALL iom_put( "sotrefml" , hmld_tref(:,:) ) ! "T criterion Mixed Layer Depth 119 120 CALL dia_calctmb( tsn(:,:,:,jp_sal),zwtmb ) 121 CALL iom_put( "top_sal" , zwtmb(:,:,1) ) ! tmb Salinity 122 CALL iom_put( "mid_sal" , zwtmb(:,:,2) ) ! tmb Salinity 123 CALL iom_put( "bot_sal" , zwtmb(:,:,3) ) ! tmb Salinity 124 125 CALL dia_calctmb( un(:,:,:),zwtmb ) 126 CALL iom_put( "top_u" , zwtmb(:,:,1) ) ! tmb U Velocity 127 CALL iom_put( "mid_u" , zwtmb(:,:,2) ) ! tmb U Velocity 128 CALL iom_put( "bot_u" , zwtmb(:,:,3) ) ! tmb U Velocity 129 !Called in dynspg_ts.F90 CALL iom_put( "baro_u" , un_b ) ! Barotropic U Velocity 130 131 CALL dia_calctmb( vn(:,:,:),zwtmb ) 132 CALL iom_put( "top_v" , zwtmb(:,:,1) ) ! tmb V Velocity 133 CALL iom_put( "mid_v" , zwtmb(:,:,2) ) ! tmb V Velocity 134 CALL iom_put( "bot_v" , zwtmb(:,:,3) ) ! tmb V Velocity 135 !Called in dynspg_ts.F90 CALL iom_put( "baro_v" , vn_b ) ! Barotropic V Velocity 136 CALL wrk_dealloc( jpi,jpj,3 , zwtmb ) 137 ELSE 138 CALL ctl_warn('dia_tmb: tmb diagnostic is set to false you should not have seen this') 139 ENDIF 108 CALL dia_calctmb( tsn(:,:,:,jp_tem), zwtmb ) 109 !ssh already output but here we output it masked 110 CALL iom_put( "sshnmasked", sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) ) 111 CALL iom_put( "top_temp" , zwtmb(:,:,1) ) ! tmb Temperature 112 CALL iom_put( "mid_temp" , zwtmb(:,:,2) ) ! tmb Temperature 113 CALL iom_put( "bot_temp" , zwtmb(:,:,3) ) ! tmb Temperature 114 ! 115 CALL dia_calctmb( tsn(:,:,:,jp_sal), zwtmb ) 116 CALL iom_put( "top_sal" , zwtmb(:,:,1) ) ! tmb Salinity 117 CALL iom_put( "mid_sal" , zwtmb(:,:,2) ) ! tmb Salinity 118 CALL iom_put( "bot_sal" , zwtmb(:,:,3) ) ! tmb Salinity 119 ! 120 CALL dia_calctmb( un(:,:,:), zwtmb ) 121 CALL iom_put( "top_u" , zwtmb(:,:,1) ) ! tmb U Velocity 122 CALL iom_put( "mid_u" , zwtmb(:,:,2) ) ! tmb U Velocity 123 CALL iom_put( "bot_u" , zwtmb(:,:,3) ) ! tmb U Velocity 124 ! 125 CALL dia_calctmb( vn(:,:,:), zwtmb ) 126 CALL iom_put( "top_v" , zwtmb(:,:,1) ) ! tmb V Velocity 127 CALL iom_put( "mid_v" , zwtmb(:,:,2) ) ! tmb V Velocity 128 CALL iom_put( "bot_v" , zwtmb(:,:,3) ) ! tmb V Velocity 140 129 ! 141 130 END SUBROUTINE dia_tmb 131 142 132 !!====================================================================== 143 133 END MODULE diatmb -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r9023 r9124 126 126 !!---------------------------------------------------------------------- 127 127 ! 128 IF( nn_timing == 1) CALL timing_start('dia_wri')128 IF( ln_timing ) CALL timing_start('dia_wri') 129 129 ! 130 130 ! Output the initial state and forcings … … 402 402 IF (ln_dia25h) CALL dia_25h( kt ) ! 25h averaging 403 403 404 IF( nn_timing == 1) CALL timing_stop('dia_wri')404 IF( ln_timing ) CALL timing_stop('dia_wri') 405 405 ! 406 406 END SUBROUTINE dia_wri … … 438 438 !!---------------------------------------------------------------------- 439 439 ! 440 IF( nn_timing == 1) CALL timing_start('dia_wri')440 IF( ln_timing ) CALL timing_start('dia_wri') 441 441 ! 442 442 IF( ninist == 1 ) THEN !== Output the initial state and forcings ==! … … 859 859 ENDIF 860 860 ! 861 IF( nn_timing == 1) CALL timing_stop('dia_wri')861 IF( ln_timing ) CALL timing_stop('dia_wri') 862 862 ! 863 863 END SUBROUTINE dia_wri
Note: See TracChangeset
for help on using the changeset viewer.
