Changeset 7277 for branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DIA
- Timestamp:
- 2016-11-21T09:55:07+01:00 (8 years ago)
- Location:
- branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DIA
- Files:
-
- 1 deleted
- 3 edited
-
diadct.F90 (modified) (7 diffs)
-
diafwb.F90 (deleted)
-
diatmb.F90 (modified) (6 diffs)
-
diawri.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r6140 r7277 392 392 ENDIF 393 393 394 IF( iptglo .NE.0 )THEN394 IF( iptglo /= 0 )THEN 395 395 396 396 !read points'coordinates and directions … … 399 399 directemp(:) = 0 !value of directions of each points 400 400 DO jpt=1,iptglo 401 READ(numdct_in) i1,i2401 READ(numdct_in) i1, i2 402 402 coordtemp(jpt)%I = i1 403 403 coordtemp(jpt)%J = i2 404 404 ENDDO 405 READ(numdct_in) directemp(1:iptglo)405 READ(numdct_in) directemp(1:iptglo) 406 406 407 407 !debug … … 416 416 !Now each proc selects only points that are in its domain: 417 417 !-------------------------------------------------------- 418 iptloc = 0 ! initialize number of points selected419 DO jpt =1,iptglo !loop on listpoint read in the file420 418 iptloc = 0 ! initialize number of points selected 419 DO jpt = 1, iptglo ! loop on listpoint read in the file 420 ! 421 421 iiglo=coordtemp(jpt)%I ! global coordinates of the point 422 422 ijglo=coordtemp(jpt)%J ! " 423 423 424 IF( iiglo==jpi dta .AND. nimpp==1 ) iiglo = 2425 426 iiloc=iiglo- jpizoom+1-nimpp+1 ! local coordinates of the point427 ijloc=ijglo- jpjzoom+1-njmpp+1 ! "424 IF( iiglo==jpiglo .AND. nimpp==1 ) iiglo = 2 !!gm BUG: Hard coded periodicity ! 425 426 iiloc=iiglo-nimpp+1 ! local coordinates of the point 427 ijloc=ijglo-njmpp+1 ! " 428 428 429 429 !verify if the point is on the local domain:(1,nlei)*(1,nlej) 430 IF( iiloc .GE. 1 .AND. iiloc .LE.nlei .AND. &431 ijloc .GE. 1 .AND. ijloc .LE.nlej )THEN430 IF( iiloc >= 1 .AND. iiloc <= nlei .AND. & 431 ijloc >= 1 .AND. ijloc <= nlej )THEN 432 432 iptloc = iptloc + 1 ! count local points 433 433 secs(jsec)%listPoint(iptloc) = POINT_SECTION(mi0(iiglo),mj0(ijglo)) ! store local coordinates 434 434 secs(jsec)%direction(iptloc) = directemp(jpt) ! store local direction 435 435 ENDIF 436 437 END DO436 ! 437 END DO 438 438 439 439 secs(jsec)%nb_point=iptloc !store number of section's points … … 444 444 WRITE(numout,*)" List of points selected by the proc:" 445 445 DO jpt = 1,iptloc 446 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 +nimpp - 1447 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 +njmpp - 1446 iiglo = secs(jsec)%listPoint(jpt)%I + nimpp - 1 447 ijglo = secs(jsec)%listPoint(jpt)%J + njmpp - 1 448 448 WRITE(numout,*)' # I J : ',iiglo,ijglo 449 449 ENDDO … … 452 452 IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN 453 453 DO jpt = 1,iptloc 454 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 +nimpp - 1455 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 +njmpp - 1454 iiglo = secs(jsec)%listPoint(jpt)%I + nimpp - 1 455 ijglo = secs(jsec)%listPoint(jpt)%J + njmpp - 1 456 456 ENDDO 457 457 ENDIF … … 468 468 IF(jsec==nn_secdebug .AND. secs(jsec)%nb_point .NE. 0)THEN 469 469 DO jpt = 1,secs(jsec)%nb_point 470 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 +nimpp - 1471 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 +njmpp - 1470 iiglo = secs(jsec)%listPoint(jpt)%I + nimpp - 1 471 ijglo = secs(jsec)%listPoint(jpt)%J + njmpp - 1 472 472 ENDDO 473 473 ENDIF … … 479 479 iptloc = secs(jsec)%nb_point 480 480 DO jpt = 1,iptloc 481 iiglo = secs(jsec)%listPoint(jpt)%I + jpizoom - 1 +nimpp - 1482 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 +njmpp - 1481 iiglo = secs(jsec)%listPoint(jpt)%I + nimpp - 1 482 ijglo = secs(jsec)%listPoint(jpt)%J + njmpp - 1 483 483 WRITE(numout,*)' # I J : ',iiglo,ijglo 484 484 CALL FLUSH(numout) -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90
r6140 r7277 4 4 !! Harmonic analysis of tidal constituents 5 5 !!====================================================================== 6 !! History : 3.6 ! 2014 (E O'Dea) Original code 6 !! History : 3.6 ! 08-2014 (E O'Dea) Original code 7 !! 3.7 ! 05-2016 (G. Madec) use mbkt, mikt to account for ocean cavities 7 8 !!---------------------------------------------------------------------- 8 9 USE oce ! ocean dynamics and tracers variables 9 10 USE dom_oce ! ocean space and time domain 11 ! 10 12 USE in_out_manager ! I/O units 11 13 USE iom ! I/0 library … … 31 33 !! *** ROUTINE dia_tmb_init *** 32 34 !! 33 !! ** Purpose :Initialization of tmb namelist35 !! ** Purpose : Initialization of tmb namelist 34 36 !! 35 !! ** Method : Read namelist 36 !! History 37 !! 3.6 ! 08-14 (E. O'Dea) Routine to initialize dia_tmb 37 !! ** Method : Read namelist 38 38 !!--------------------------------------------------------------------------- 39 !!40 39 INTEGER :: ios ! Local integer output status for namelist read 41 40 ! … … 59 58 WRITE(numout,*) 'Switch for TMB diagnostics (T) or not (F) ln_diatmb = ', ln_diatmb 60 59 ENDIF 61 60 ! 62 61 END SUBROUTINE dia_tmb_init 63 62 64 SUBROUTINE dia_calctmb( pinfield,pouttmb ) 63 64 SUBROUTINE dia_calctmb( pfield, ptmb ) 65 65 !!--------------------------------------------------------------------- 66 66 !! *** ROUTINE dia_tmb *** … … 68 68 !! ** Purpose : Find the Top, Mid and Bottom fields of water Column 69 69 !! 70 !! ** Method : 71 !! use mbathy to find surface, mid and bottom of model levels70 !! ** Method : use mbkt, mikt to find surface, mid and bottom of 71 !! model levels due to potential existence of ocean cavities 72 72 !! 73 !! History :74 !! 3.6 ! 08-14 (E. O'Dea) Routine based on dia_wri_foam75 73 !!---------------------------------------------------------------------- 76 !! * Modules used 77 78 ! Routine to map 3d field to top, middle, bottom 79 IMPLICIT NONE 80 81 82 ! Routine arguments 83 REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(IN ) :: pinfield ! Input 3d field and mask 84 REAL(wp), DIMENSION(jpi, jpj, 3 ), INTENT( OUT) :: pouttmb ! Output top, middle, bottom 85 86 87 88 ! Local variables 89 INTEGER :: ji,jj,jk ! Dummy loop indices 90 91 ! Local Real 92 REAL(wp) :: zmdi ! set masked values 93 94 zmdi=1.e+20 !missing data indicator for masking 95 96 ! Calculate top 97 pouttmb(:,:,1) = pinfield(:,:,1)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1)) 98 99 ! Calculate middle 100 DO jj = 1,jpj 101 DO ji = 1,jpi 102 jk = max(1,mbathy(ji,jj)/2) 103 pouttmb(ji,jj,2) = pinfield(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 74 REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(in ) :: pfield ! Input 3d field and mask 75 REAL(wp), DIMENSION(jpi, jpj, 3 ), INTENT( out) :: ptmb ! top, middle, bottom extracted from pfield 76 ! 77 INTEGER :: ji, jj ! Dummy loop indices 78 INTEGER :: itop, imid, ibot ! local integers 79 REAL(wp) :: zmdi = 1.e+20_wp ! land value 80 !!--------------------------------------------------------------------- 81 ! 82 DO jj = 1, jpj 83 DO ji = 1, jpi 84 itop = mikt(ji,jj) ! top ocean 85 ibot = mbkt(ji,jj) ! bottom ocean 86 imid = itop + ( ibot - itop + 1 ) / 2 ! middle ocean 87 ! 88 ptmb(ji,jj,1) = pfield(ji,jj,itop)*tmask(ji,jj,itop) + zmdi*( 1._wp-tmask(ji,jj,itop) ) 89 ptmb(ji,jj,2) = pfield(ji,jj,imid)*tmask(ji,jj,imid) + zmdi*( 1._wp-tmask(ji,jj,imid) ) 90 ptmb(ji,jj,3) = pfield(ji,jj,ibot)*tmask(ji,jj,ibot) + zmdi*( 1._wp-tmask(ji,jj,ibot) ) 104 91 END DO 105 92 END DO 106 107 ! Calculate bottom 108 DO jj = 1,jpj 109 DO ji = 1,jpi 110 jk = max(1,mbathy(ji,jj) - 1) 111 pouttmb(ji,jj,3) = pinfield(ji,jj,jk)*tmask(ji,jj,jk) + zmdi*(1.0-tmask(ji,jj,jk)) 112 END DO 113 END DO 114 93 ! 115 94 END SUBROUTINE dia_calctmb 116 117 95 118 96 … … 122 100 !! ** Purpose : Write diagnostics for Top, Mid and Bottom of water Column 123 101 !! 124 !! ** Method : 125 !! use mbathy to find surface, mid and bottom of model levels 102 !! ** Method : use mikt,mbkt to find surface, mid and bottom of model levels 126 103 !! calls calctmb to retrieve TMB values before sending to iom_put 127 104 !! 128 !! History :129 !! 3.6 ! 08-14 (E. O'Dea)130 !!131 105 !!-------------------------------------------------------------------- 132 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb ! temporary workspace 133 REAL(wp) :: zmdi ! set masked values 134 135 zmdi=1.e+20 !missing data indicator for maskin 136 106 REAL(wp) :: zmdi =1.e+20 ! land value 107 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb ! workspace 108 !!-------------------------------------------------------------------- 109 ! 137 110 IF (ln_diatmb) THEN 138 CALL wrk_alloc( jpi , jpj, 3, zwtmb )111 CALL wrk_alloc( jpi,jpj,3 , zwtmb ) 139 112 CALL dia_calctmb( tsn(:,:,:,jp_tem),zwtmb ) 140 113 !ssh already output but here we output it masked 141 CALL iom_put( "sshnmasked" , sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) ) ! tmb Temperature114 CALL iom_put( "sshnmasked" , sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) ) 142 115 CALL iom_put( "top_temp" , zwtmb(:,:,1) ) ! tmb Temperature 143 116 CALL iom_put( "mid_temp" , zwtmb(:,:,2) ) ! tmb Temperature … … 161 134 CALL iom_put( "bot_v" , zwtmb(:,:,3) ) ! tmb V Velocity 162 135 !Called in dynspg_ts.F90 CALL iom_put( "baro_v" , vn_b ) ! Barotropic V Velocity 136 CALL wrk_dealloc( jpi,jpj,3 , zwtmb ) 163 137 ELSE 164 138 CALL ctl_warn('dia_tmb: tmb diagnostic is set to false you should not have seen this') 165 139 ENDIF 166 140 ! 167 141 END SUBROUTINE dia_tmb 168 142 !!====================================================================== -
branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r6387 r7277 666 666 CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm" , "m" , & ! hd28 667 667 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 668 CALL histdef( nid_T, "sohtc300", "Heat content 300 m" , " W", & ! htc3668 CALL histdef( nid_T, "sohtc300", "Heat content 300 m" , "J/m2" , & ! htc3 669 669 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 670 670 #endif
Note: See TracChangeset
for help on using the changeset viewer.
