- Timestamp:
- 2018-09-12T15:59:13+02:00 (6 years ago)
- Location:
- NEMO/branches/2018/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA
- Files:
-
- 4 edited
-
diaar5.F90 (modified) (3 diffs)
-
diadct.F90 (modified) (10 diffs)
-
diaprod.F90 (modified) (1 diff)
-
diawri.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90
r7806 r10115 81 81 ! 82 82 REAL(wp), POINTER, DIMENSION(:,:) :: zarea_ssh , zbotpres ! 2D workspace 83 REAL(wp), POINTER, DIMENSION(:,:) :: pe! 2D workspace83 REAL(wp), POINTER, DIMENSION(:,:) :: zpe ! 2D workspace 84 84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zrhd , zrhop ! 3D workspace 85 85 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsn ! 4D workspace … … 91 91 IF( kt == nit000 ) CALL dia_ar5_init 92 92 93 CALL wrk_alloc( jpi , jpj , zarea_ssh , zbotpres, pe )94 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop )95 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn )93 CALL wrk_alloc( jpi , jpj , zarea_ssh , zbotpres, zpe ) 94 CALL wrk_alloc( jpi , jpj , jpk , zrhd , zrhop ) 95 CALL wrk_alloc( jpi , jpj , jpk , jpts , ztsn ) 96 96 97 97 zarea_ssh(:,:) = area(:,:) * sshn(:,:) … … 206 206 ! Exclude points where rn2 is negative as convection kicks in here and 207 207 ! work is not being done against stratification 208 pe(:,:) = 0._wp 209 IF( lk_zdfddm ) THEN 210 DO ji=1,jpi 211 DO jj=1,jpj 212 DO jk=1,jpk 213 zrw = ( fsdepw(ji,jj,jk ) - fsdept(ji,jj,jk) ) & 214 & / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 215 ! 216 zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 217 zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 218 ! 219 pe(ji, jj) = pe(ji, jj) - MIN(0._wp, rn2(ji,jj,jk)) * & 220 & grav * (avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) & 221 & - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 222 223 ENDDO 224 ENDDO 225 ENDDO 208 zpe(:,:) = 0._wp 209 IF( lk_zdfddm ) THEN 210 DO jk = 2, jpk 211 DO jj = 1, jpj 212 DO ji = 1, jpi 213 IF( rn2(ji,jj,jk) > 0._wp ) THEN 214 zrw = ( fsdepw(ji,jj,jk ) - fsdept(ji,jj,jk) ) & 215 & / ( fsdept(ji,jj,jk-1) - fsdept(ji,jj,jk) ) 216 ! 217 zaw = rab_n(ji,jj,jk,jp_tem) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_tem)* zrw 218 zbw = rab_n(ji,jj,jk,jp_sal) * (1. - zrw) + rab_n(ji,jj,jk-1,jp_sal)* zrw 219 ! 220 zpe(ji, jj) = zpe(ji, jj) & 221 & - grav * ( avt(ji,jj,jk) * zaw * (tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) & 222 & - fsavs(ji,jj,jk) * zbw * (tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) ) ) 223 ENDIF 224 END DO 225 END DO 226 END DO 226 227 ELSE 227 DO ji=1,jpi228 DO jj=1,jpj229 DO jk=1,jpk230 pe(ji,jj) =pe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * fse3w(ji, jj, jk)231 ENDDO232 ENDDO233 ENDDO234 235 CALL lbc_lnk(pe, 'T', 1._wp)236 CALL iom_put( 'tnpeo', pe)228 DO jk = 1, jpk 229 DO ji = 1, jpi 230 DO jj = 1, jpj 231 zpe(ji,jj) = zpe(ji,jj) + avt(ji, jj, jk) * MIN(0._wp,rn2(ji, jj, jk)) * rau0 * fse3w(ji, jj, jk) 232 END DO 233 END DO 234 END DO 235 ENDIF 236 CALL lbc_lnk(zpe, 'T', 1._wp) 237 CALL iom_put( 'tnpeo', zpe ) 237 238 ENDIF 238 239 ! 239 CALL wrk_dealloc( jpi , jpj , zarea_ssh , zbotpres, pe )240 CALL wrk_dealloc( jpi , jpj , jpk , zrhd , zrhop )241 CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn )240 CALL wrk_dealloc( jpi , jpj , zarea_ssh , zbotpres, zpe ) 241 CALL wrk_dealloc( jpi , jpj , jpk , zrhd , zrhop ) 242 CALL wrk_dealloc( jpi , jpj , jpk , jpts , ztsn ) 242 243 ! 243 244 IF( nn_timing == 1 ) CALL timing_stop('dia_ar5') -
NEMO/branches/2018/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r5602 r10115 249 249 !debug this section computing ? 250 250 lldebug=.FALSE. 251 IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. kt==nit000+nn_dct-1 .AND. lwp) lldebug=.TRUE.251 IF( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. kt==nit000+nn_dct-1 ) lldebug=.TRUE. 252 252 253 253 !Compute transport through section … … 258 258 IF( MOD(kt,nn_dctwri)==0 )THEN 259 259 260 IF( lwp .AND.kt==nit000+nn_dctwri-1 )WRITE(numout,*)" diadct: average transports and write at kt = ",kt260 IF( kt==nit000+nn_dctwri-1 )WRITE(numout,*)" diadct: average transports and write at kt = ",kt 261 261 262 262 !! divide arrays by nn_dctwri/nn_dct to obtain average … … 344 344 DO jsec=1,nb_sec_max !loop on the nb_sec sections 345 345 346 IF ( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 )) &346 IF ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) & 347 347 & WRITE(numout,*)'debuging for section number: ',jsec 348 348 … … 364 364 IF( jsec .NE. isec ) CALL ctl_stop( cltmp ) 365 365 366 IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ))WRITE(numout,*)"isec ",isec366 IF( jsec==nn_secdebug .OR. nn_secdebug==-1 )WRITE(numout,*)"isec ",isec 367 367 368 368 READ(numdct_in)secs(jsec)%name … … 383 383 !----- 384 384 385 IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ))THEN385 IF( jsec==nn_secdebug .OR. nn_secdebug==-1 )THEN 386 386 387 387 WRITE(clformat,'(a,i2,a)') '(A40,', nb_class_max,'(f8.3,1X))' … … 416 416 !debug 417 417 !----- 418 IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ))THEN418 IF( jsec==nn_secdebug .OR. nn_secdebug==-1 )THEN 419 419 WRITE(numout,*)" List of points in global domain:" 420 420 DO jpt=1,iptglo … … 450 450 !debug 451 451 !----- 452 IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ))THEN452 IF( jsec==nn_secdebug .OR. nn_secdebug==-1 )THEN 453 453 WRITE(numout,*)" List of points selected by the proc:" 454 454 DO jpt = 1,iptloc … … 468 468 !remove redundant points between processors 469 469 !------------------------------------------ 470 lldebug = .FALSE. ; IF ( (jsec==nn_secdebug .OR. nn_secdebug==-1) .AND. lwp) lldebug = .TRUE.470 lldebug = .FALSE. ; IF ( jsec==nn_secdebug .OR. nn_secdebug==-1 ) lldebug = .TRUE. 471 471 IF( iptloc .NE. 0 )THEN 472 472 CALL removepoints(secs(jsec),'I','top_list',lldebug) … … 484 484 !debug 485 485 !----- 486 IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ))THEN486 IF( jsec==nn_secdebug .OR. nn_secdebug==-1 )THEN 487 487 WRITE(numout,*)" List of points after removepoints:" 488 488 iptloc = secs(jsec)%nb_point … … 496 496 497 497 ELSE ! iptglo = 0 498 IF( lwp .AND. ( jsec==nn_secdebug .OR. nn_secdebug==-1 ))&498 IF( jsec==nn_secdebug .OR. nn_secdebug==-1 )& 499 499 WRITE(numout,*)' No points for this section.' 500 500 ENDIF -
NEMO/branches/2018/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diaprod.F90
r7806 r10115 238 238 !! Default option : NO diaprod 239 239 !!---------------------------------------------------------------------- 240 USE in_out_manager ! I/O manager 240 241 LOGICAL, PUBLIC, PARAMETER :: lk_diaprod = .FALSE. ! coupled flag 241 242 CONTAINS 242 243 SUBROUTINE dia_prod( kt ) ! Empty routine 243 244 INTEGER :: kt 244 WRITE(*,*) 'dia_prod: You should not have seen this print! error?', kt 245 IF( kt == nit000 .AND. lwp ) & 246 WRITE(*,*) 'dia_prod: You should not have seen this print! error?', kt 245 247 END SUBROUTINE dia_prod 246 248 #endif -
NEMO/branches/2018/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r7806 r10115 296 296 ! 297 297 IF ( iom_use("eken") ) THEN 298 rke(:,:,j k) = 0._wp ! kinetic energy298 rke(:,:,jpk) = 0._wp ! kinetic energy 299 299 DO jk = 1, jpkm1 300 300 DO jj = 2, jpjm1 301 301 DO ji = fs_2, fs_jpim1 ! vector opt. 302 zztmp = 1._wp / ( e1e2t(ji,jj) * fse3t(ji,jj,jk))303 zztmpx = 0.5 * ( un(ji-1,jj,jk) * un(ji-1,jj,jk) * e 2u(ji-1,jj) * fse3u(ji-1,jj,jk) &304 & + un(ji ,jj,jk) * un(ji ,jj,jk) * e 2u(ji ,jj) * fse3u(ji ,jj,jk) ) &302 zztmp = 1 / (e1e2t(ji,jj) * fse3t(ji,jj,jk)) 303 zztmpx = 0.5 * ( un(ji-1,jj,jk) * un(ji-1,jj,jk) * e1u(ji-1,jj) * e2u(ji-1,jj) * fse3u(ji-1,jj,jk) & 304 & + un(ji ,jj,jk) * un(ji ,jj,jk) * e1u(ji, jj) * e2u(ji ,jj) * fse3u(ji ,jj,jk) ) & 305 305 & * zztmp 306 306 ! 307 zztmpy = 0.5 * ( vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * fse3v(ji,jj-1,jk) &308 & + vn(ji,jj ,jk) * vn(ji,jj ,jk) * e1v(ji,jj ) * fse3v(ji,jj ,jk) ) &307 zztmpy = 0.5 * ( vn(ji,jj-1,jk) * vn(ji,jj-1,jk) * e1v(ji,jj-1) * e2v(ji,jj-1) * fse3v(ji,jj-1,jk) & 308 & + vn(ji,jj ,jk) * vn(ji,jj ,jk) * e1v(ji,jj ) * e2v(ji,jj ) * fse3v(ji,jj ,jk) ) & 309 309 & * zztmp 310 310 !
Note: See TracChangeset
for help on using the changeset viewer.
