Changeset 8850 for branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO
- Timestamp:
- 2017-11-30T09:30:44+01:00 (7 years ago)
- Location:
- branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO
- Files:
-
- 5 edited
-
OPA_SRC/IOM/iom.F90 (modified) (18 diffs)
-
OPA_SRC/TRA/tranxt.F90 (modified) (10 diffs)
-
OPA_SRC/TRA/trazdf.F90 (modified) (2 diffs)
-
OPA_SRC/TRD/trdtra.F90 (modified) (7 diffs)
-
TOP_SRC/TRP/trcnxt.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r8817 r8850 205 205 ! end file definition 206 206 dtime%second = rdt 207 CALL xios_set_timestep( dtime)207 CALL xios_set_timestep( dtime ) 208 208 CALL xios_close_context_definition() 209 210 CALL xios_update_calendar(0) 209 CALL xios_update_calendar( 0 ) 211 210 ! 212 211 DEALLOCATE( zt_bnds, zw_bnds ) … … 253 252 LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 254 253 INTEGER , INTENT(in ), OPTIONAL :: kdlev ! number of vertical levels 255 254 ! 256 255 CHARACTER(LEN=256) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu] 257 256 CHARACTER(LEN=256) :: cltmpn ! tempory name to store clname (in writting mode) … … 645 644 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 646 645 LOGICAL , INTENT(in ), OPTIONAL :: lrowattr ! logical flag telling iom_get to 647 648 649 646 ! ! look for and use a file attribute 647 ! ! called open_ocean_jstart to set the start 648 ! ! value for the 2nd dimension (netcdf only) 650 649 ! 651 650 LOGICAL :: llnoov ! local definition to read overlap … … 780 779 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN 781 780 istart(1:idmspc) = kstart(1:idmspc) 782 icnt (1:idmspc) = kcount(1:idmspc)781 icnt (1:idmspc) = kcount(1:idmspc) 783 782 ELSE 784 783 IF(idom == jpdom_unknown ) THEN … … 806 805 ENDIF 807 806 IF( PRESENT(pv_r3d) ) THEN 808 IF( idom == jpdom_data ) THEN ;icnt(3) = inlev809 ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3);icnt(3) = kcount(3)810 ELSE ;icnt(3) = inlev807 IF( idom == jpdom_data ) THEN ; icnt(3) = inlev 808 ELSEIF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3) ; icnt(3) = kcount(3) 809 ELSE ; icnt(3) = inlev 811 810 ENDIF 812 811 ENDIF … … 1251 1250 1252 1251 #if defined key_iomput 1253 1254 1252 !!---------------------------------------------------------------------- 1255 1253 !! 'key_iomput' IOM interface … … 1413 1411 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 1414 1412 ! 1415 INTEGER :: ni, nj1413 INTEGER :: ni, nj 1416 1414 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask 1417 1415 !!---------------------------------------------------------------------- 1418 1416 ! 1419 ni=nlei-nldi+1 ; nj=nlej-nldj+1 1417 ni = nlei-nldi+1 1418 nj = nlej-nldj+1 1420 1419 ! 1421 1420 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) … … 1468 1467 END SELECT 1469 1468 ! 1470 ni = nlei-nldi+1 ; nj = nlej-nldj+1 ! Dimensions of subdomain interior 1469 ni = nlei-nldi+1 ! Dimensions of subdomain interior 1470 nj = nlej-nldj+1 1471 1471 ! 1472 1472 z_fld(:,:) = 1._wp … … 1553 1553 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plat 1554 1554 ! 1555 INTEGER :: ni, nj, ix, iy 1555 1556 REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon 1556 INTEGER :: ni,nj, ix, iy1557 ! !----------------------------------------------------------------------1558 !1559 n i=nlei-nldi+1 ; nj=nlej-nldj+1 ! define zonal mean domain (jpj*jpk)1560 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0. 1557 !!---------------------------------------------------------------------- 1558 ! 1559 ni=nlei-nldi+1 ! define zonal mean domain (jpj*jpk) 1560 nj=nlej-nldj+1 1561 ALLOCATE( zlon(ni*nj) ) ; zlon(:) = 0._wp 1561 1562 ! 1562 1563 CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) ! i-line that passes through Bering Strait: Reference latitude (used in plots) … … 1616 1617 ! 1617 1618 ! frequency of the call of iom_put (attribut: freq_op) 1618 f_op%timestep = 1 ; f_of%timestep = 0 ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of) 1619 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC' , freq_op=f_op, freq_offset=f_of) 1620 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC_scalar' , freq_op=f_op, freq_offset=f_of) 1621 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('ptrc_T' , freq_op=f_op, freq_offset=f_of) 1622 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('diad_T' , freq_op=f_op, freq_offset=f_of) 1619 f_op%timestep = 1 ; f_of%timestep = 0 ; CALL iom_set_field_attr('field_definition', freq_op=f_op, freq_offset=f_of) 1620 f_op%timestep = 2 ; f_of%timestep = 0 ; CALL iom_set_field_attr('trendT_even' , freq_op=f_op, freq_offset=f_of) 1621 f_op%timestep = 2 ; f_of%timestep = -1 ; CALL iom_set_field_attr('trendT_odd' , freq_op=f_op, freq_offset=f_of) 1622 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC' , freq_op=f_op, freq_offset=f_of) 1623 f_op%timestep = nn_fsbc ; f_of%timestep = 0 ; CALL iom_set_field_attr('SBC_scalar' , freq_op=f_op, freq_offset=f_of) 1624 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('ptrc_T' , freq_op=f_op, freq_offset=f_of) 1625 f_op%timestep = nn_dttrc ; f_of%timestep = 0 ; CALL iom_set_field_attr('diad_T' , freq_op=f_op, freq_offset=f_of) 1623 1626 1624 1627 ! output file names (attribut: name) … … 1753 1756 TYPE(xios_duration) :: output_freq 1754 1757 !!---------------------------------------------------------------------- 1755 1756 DO jn = 1, 21757 1758 ! 1759 DO jn = 1, 2 1760 ! 1758 1761 output_freq = xios_duration(0,0,0,0,0,0) 1759 1762 IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = output_freq ) 1760 1763 IF( jn == 2 ) CALL iom_get_file_attr( cdid, name_suffix = clname ) 1761 1764 ! 1762 1765 IF ( TRIM(clname) /= '' ) THEN 1763 1766 ! 1764 1767 idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') 1765 1768 DO WHILE ( idx /= 0 ) … … 1767 1770 idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') 1768 1771 END DO 1769 1772 ! 1770 1773 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1771 1774 DO WHILE ( idx /= 0 ) … … 1798 1801 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1799 1802 END DO 1800 1803 ! 1801 1804 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 1802 1805 DO WHILE ( idx /= 0 ) … … 1805 1808 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 1806 1809 END DO 1807 1810 ! 1808 1811 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 1809 1812 DO WHILE ( idx /= 0 ) … … 1812 1815 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 1813 1816 END DO 1814 1817 ! 1815 1818 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 1816 1819 DO WHILE ( idx /= 0 ) … … 1844 1847 !! ** Purpose : send back the date corresponding to the given julian day 1845 1848 !!---------------------------------------------------------------------- 1846 REAL(wp), INTENT(in ) :: pjday 1847 LOGICAL , INTENT(in ), OPTIONAL :: ld24 1848 LOGICAL , INTENT(in ), OPTIONAL :: ldfull 1849 REAL(wp), INTENT(in ) :: pjday ! julian day 1850 LOGICAL , INTENT(in ), OPTIONAL :: ld24 ! true to force 24:00 instead of 00:00 1851 LOGICAL , INTENT(in ), OPTIONAL :: ldfull ! true to get the compleate date: yyyymmdd_hh:mm:ss 1849 1852 ! 1850 1853 CHARACTER(LEN=20) :: iom_sdate … … 1892 1895 1893 1896 #else 1897 !!---------------------------------------------------------------------- 1898 !! NOT 'key_iomput' a few dummy routines 1899 !!---------------------------------------------------------------------- 1894 1900 1895 1901 SUBROUTINE iom_setkt( kt, cdname ) … … 1907 1913 1908 1914 LOGICAL FUNCTION iom_use( cdname ) 1915 !!---------------------------------------------------------------------- 1916 !!---------------------------------------------------------------------- 1909 1917 CHARACTER(LEN=*), INTENT(in) :: cdname 1918 !!---------------------------------------------------------------------- 1910 1919 #if defined key_iomput 1911 1920 iom_use = xios_field_is_active( cdname ) -
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90
r8568 r8850 113 113 114 114 ! set time step size (Euler/Leapfrog) 115 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt! at nit000 (Euler)115 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! at nit000 (Euler) 116 116 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt = 2._wp* rdt ! at nit000 or nit000+1 (Leapfrog) 117 117 ENDIF … … 120 120 IF( l_trdtra ) THEN 121 121 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 122 ztrdt(:,:,j k) = 0._wp123 ztrds(:,:,j k) = 0._wp122 ztrdt(:,:,jpk) = 0._wp 123 ztrds(:,:,jpk) = 0._wp 124 124 IF( ln_traldf_iso ) THEN ! diagnose the "pure" Kz diffusive trend 125 125 CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt ) … … 127 127 ENDIF 128 128 ! total trend for the non-time-filtered variables. 129 zfact = 1.0 / rdt 129 zfact = 1.0 / rdt 130 ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from tsn terms 130 131 DO jk = 1, jpkm1 131 ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem) - tsn(:,:,jk,jp_tem) ) * zfact132 ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal) - tsn(:,:,jk,jp_sal) ) * zfact132 ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jp_tem)) * zfact 133 ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jp_sal)) * zfact 133 134 END DO 134 135 CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt ) 135 136 CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds ) 136 ! Store now fields before applying the Asselin filter 137 ! in order to calculate Asselin filter trend later. 138 ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 139 ztrds(:,:,:) = tsn(:,:,:,jp_sal) 137 IF( ln_linssh ) THEN ! linear sea surface height only 138 ! Store now fields before applying the Asselin filter 139 ! in order to calculate Asselin filter trend later. 140 ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 141 ztrds(:,:,:) = tsn(:,:,:,jp_sal) 142 ENDIF 140 143 ENDIF 141 144 … … 146 149 END DO 147 150 END DO 151 IF (l_trdtra .AND. .NOT. ln_linssh ) THEN ! Zero Asselin filter contribution must be explicitly written out since for vvl 152 ! ! Asselin filter is output by tra_nxt_vvl that is not called on this time step 153 ztrdt(:,:,:) = 0._wp 154 ztrds(:,:,:) = 0._wp 155 CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 156 CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 157 END IF 148 158 ! 149 159 ELSE ! Leap-Frog + Asselin filter time stepping … … 161 171 ENDIF 162 172 ! 163 IF( l_trdtra ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 173 IF( l_trdtra .AND. ln_linssh ) THEN ! trend of the Asselin filter (tb filtered - tb)/dt 174 zfact = 1._wp / r2dt 164 175 DO jk = 1, jpkm1 165 zfact = 1._wp / r2dt166 176 ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact 167 177 ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact … … 169 179 CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt ) 170 180 CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds ) 171 DEALLOCATE( ztrdt , ztrds )172 181 END IF 182 IF( l_trdtra ) DEALLOCATE( ztrdt , ztrds ) 173 183 ! 174 184 ! ! control print … … 258 268 LOGICAL :: ll_traqsr, ll_rnf, ll_isf ! local logical 259 269 INTEGER :: ji, jj, jk, jn ! dummy loop indices 260 REAL(wp) :: zfact 1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar270 REAL(wp) :: zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d ! local scalar 261 271 REAL(wp) :: zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d ! - - 272 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrd_atf 262 273 !!---------------------------------------------------------------------- 263 274 ! … … 278 289 ENDIF 279 290 ! 291 IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) ) THEN 292 ALLOCATE( ztrd_atf(jpi,jpj,jpk,kjpt) ) 293 ztrd_atf(:,:,:,:) = 0.0_wp 294 ENDIF 295 zfact = 1._wp / r2dt 296 zfact1 = atfp * p2dt 297 zfact2 = zfact1 * r1_rau0 280 298 DO jn = 1, kjpt 281 299 DO jk = 1, jpkm1 282 zfact1 = atfp * p2dt283 zfact2 = zfact1 * r1_rau0284 300 DO jj = 2, jpjm1 285 301 DO ji = fs_2, fs_jpim1 … … 330 346 ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn) ! ptn <-- pta 331 347 ! 348 IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN 349 ztrd_atf(ji,jj,jk,jn) = (ztc_f - ztc_n) * zfact/ze3t_n 350 ENDIF 351 ! 332 352 END DO 333 353 END DO … … 336 356 END DO 337 357 ! 358 IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) ) THEN 359 IF( l_trdtra .AND. cdtype == 'TRA' ) THEN 360 CALL trd_tra( kt, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) ) 361 CALL trd_tra( kt, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) ) 362 ENDIF 363 IF( l_trdtrc .AND. cdtype == 'TRC' ) THEN 364 DO jn = 1, kjpt 365 CALL trd_tra( kt, cdtype, jn, jptra_atf, ztrd_atf(:,:,:,jn) ) 366 END DO 367 ENDIF 368 DEALLOCATE( ztrd_atf ) 369 ENDIF 370 ! 338 371 END SUBROUTINE tra_nxt_vvl 339 372 -
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRA/trazdf.F90
r8586 r8850 58 58 IF( ln_timing ) CALL timing_start('tra_zdf') 59 59 ! 60 IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000 61 r2dt = rdt ! = rdt (restarting with Euler time stepping) 62 ELSEIF( kt <= nit000 + 1) THEN ! at nit000 or nit000+1 63 r2dt = 2. * rdt ! = 2 rdt (leapfrog) 60 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! at nit000, = rdt (restarting with Euler time stepping) 61 ELSEIF( kt <= nit000 + 1 ) THEN ; r2dt = 2. * rdt ! otherwise, = 2 rdt (leapfrog) 64 62 ENDIF 65 63 ! … … 82 80 IF( l_trdtra ) THEN ! save the vertical diffusive trends for further diagnostics 83 81 DO jk = 1, jpkm1 84 ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem) - tsb(:,:,jk,jp_tem) ) / r2dt ) - ztrdt(:,:,jk) 85 ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal) - tsb(:,:,jk,jp_sal) ) / r2dt ) - ztrds(:,:,jk) 82 ztrdt(:,:,jk) = ( ( tsa(:,:,jk,jp_tem)*e3t_a(:,:,jk) - tsb(:,:,jk,jp_tem)*e3t_b(:,:,jk) ) & 83 & / (e3t_n(:,:,jk)*r2dt) ) - ztrdt(:,:,jk) 84 ztrds(:,:,jk) = ( ( tsa(:,:,jk,jp_sal)*e3t_a(:,:,jk) - tsb(:,:,jk,jp_sal)*e3t_b(:,:,jk) ) & 85 & / (e3t_n(:,:,jk)*r2dt) ) - ztrds(:,:,jk) 86 86 END DO 87 87 !!gm this should be moved in trdtra.F90 and done on all trends -
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/OPA_SRC/TRD/trdtra.F90
r8215 r8850 31 31 USE iom ! I/O manager library 32 32 USE lib_mpp ! MPP library 33 USE wrk_nemo ! Memory allocation34 33 35 34 IMPLICIT NONE … … 82 81 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! now tracer variable 83 82 ! 84 INTEGER :: jk ! loop indices 85 REAL(wp), POINTER, DIMENSION(:,:,:) :: zwt, zws, ztrdt, ztrds ! 3D workspace 86 !!---------------------------------------------------------------------- 87 ! 88 CALL wrk_alloc( jpi, jpj, jpk, ztrds ) 83 INTEGER :: jk ! loop indices 84 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztrds ! 3D workspace 85 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zwt, zws, ztrdt ! 3D workspace 86 !!---------------------------------------------------------------------- 89 87 ! 90 88 IF( .NOT. ALLOCATED( trdtx ) ) THEN ! allocate trdtra arrays … … 103 101 ztrds(:,:,:) = 0._wp 104 102 CALL trd_tra_mng( trdt, ztrds, ktrd, kt ) 103 !!gm Gurvan, verify the jptra_evd trend please ! 104 CASE( jptra_evd ) ; avt_evd(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 105 105 CASE DEFAULT ! other trends: masked trends 106 106 trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) ! mask & store … … 122 122 CASE( jptra_zdfp ) ! diagnose the "PURE" Kz trend (here: just before the swap) 123 123 ! ! iso-neutral diffusion case otherwise jptra_zdf is "PURE" 124 CALL wrk_alloc( jpi, jpj, jpk, zwt, zws, ztrdt)124 ALLOCATE( zwt(jpi,jpj,jpk), zws(jpi,jpj,jpk), ztrdt(jpi,jpj,jpk) ) 125 125 ! 126 126 zwt(:,:, 1 ) = 0._wp ; zws(:,:, 1 ) = 0._wp ! vertical diffusive fluxes … … 152 152 CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt ) 153 153 ! 154 CALL wrk_dealloc( jpi, jpj, jpk,zwt, zws, ztrdt )154 DEALLOCATE( zwt, zws, ztrdt ) 155 155 ! 156 156 CASE DEFAULT ! other trends: mask and send T & S trends to trd_tra_mng … … 174 174 ! 175 175 ENDIF 176 !177 CALL wrk_dealloc( jpi, jpj, jpk, ztrds )178 176 ! 179 177 END SUBROUTINE trd_tra … … 305 303 INTEGER :: ji, jj, jk ! dummy loop indices 306 304 INTEGER :: ikbu, ikbv ! local integers 307 REAL(wp), POINTER, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace305 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z2dx, z2dy ! 2D workspace 308 306 !!---------------------------------------------------------------------- 309 307 ! 310 308 !!gm Rq: mask the trends already masked in trd_tra, but lbc_lnk should probably be added 311 309 ! 310 ! Trends evaluated every time step that could go to the standard T file and can be output every ts into a 1ts file if 1ts output is selected 312 311 SELECT CASE( ktrd ) 313 CASE( jptra_xad ) ; CALL iom_put( "ttrd_xad" , ptrdx ) ! x- horizontal advection 314 CALL iom_put( "strd_xad" , ptrdy ) 315 CASE( jptra_yad ) ; CALL iom_put( "ttrd_yad" , ptrdx ) ! y- horizontal advection 316 CALL iom_put( "strd_yad" , ptrdy ) 317 CASE( jptra_zad ) ; CALL iom_put( "ttrd_zad" , ptrdx ) ! z- vertical advection 318 CALL iom_put( "strd_zad" , ptrdy ) 319 IF( ln_linssh ) THEN ! cst volume : adv flux through z=0 surface 320 CALL wrk_alloc( jpi, jpj, z2dx, z2dy ) 321 z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / e3t_n(:,:,1) 322 z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / e3t_n(:,:,1) 323 CALL iom_put( "ttrd_sad", z2dx ) 324 CALL iom_put( "strd_sad", z2dy ) 325 CALL wrk_dealloc( jpi, jpj, z2dx, z2dy ) 326 ENDIF 327 CASE( jptra_totad ) ; CALL iom_put( "ttrd_totad" , ptrdx ) ! total advection 328 CALL iom_put( "strd_totad" , ptrdy ) 329 CASE( jptra_ldf ) ; CALL iom_put( "ttrd_ldf" , ptrdx ) ! lateral diffusion 330 CALL iom_put( "strd_ldf" , ptrdy ) 331 CASE( jptra_zdf ) ; CALL iom_put( "ttrd_zdf" , ptrdx ) ! vertical diffusion (including Kz contribution) 332 CALL iom_put( "strd_zdf" , ptrdy ) 333 CASE( jptra_zdfp ) ; CALL iom_put( "ttrd_zdfp", ptrdx ) ! PURE vertical diffusion (no isoneutral contribution) 334 CALL iom_put( "strd_zdfp", ptrdy ) 335 CASE( jptra_evd ) ; CALL iom_put( "ttrd_evd", ptrdx ) ! EVD trend (convection) 336 CALL iom_put( "strd_evd", ptrdy ) 337 CASE( jptra_dmp ) ; CALL iom_put( "ttrd_dmp" , ptrdx ) ! internal restoring (damping) 338 CALL iom_put( "strd_dmp" , ptrdy ) 339 CASE( jptra_bbl ) ; CALL iom_put( "ttrd_bbl" , ptrdx ) ! bottom boundary layer 340 CALL iom_put( "strd_bbl" , ptrdy ) 341 CASE( jptra_npc ) ; CALL iom_put( "ttrd_npc" , ptrdx ) ! static instability mixing 342 CALL iom_put( "strd_npc" , ptrdy ) 343 CASE( jptra_nsr ) ; CALL iom_put( "ttrd_qns" , ptrdx(:,:,1) ) ! surface forcing + runoff (ln_rnf=T) 344 CALL iom_put( "strd_cdt" , ptrdy(:,:,1) ) ! output as 2D surface fields 345 CASE( jptra_qsr ) ; CALL iom_put( "ttrd_qsr" , ptrdx ) ! penetrative solar radiat. (only on temperature) 346 CASE( jptra_bbc ) ; CALL iom_put( "ttrd_bbc" , ptrdx ) ! geothermal heating (only on temperature) 347 CASE( jptra_atf ) ; CALL iom_put( "ttrd_atf" , ptrdx ) ! asselin time Filter 348 CALL iom_put( "strd_atf" , ptrdy ) 349 CASE( jptra_tot ) ; CALL iom_put( "ttrd_tot" , ptrdx ) ! model total trend 312 ! This total trend is done every time step 313 CASE( jptra_tot ) ; CALL iom_put( "ttrd_tot" , ptrdx ) ! model total trend 350 314 CALL iom_put( "strd_tot" , ptrdy ) 351 315 END SELECT 352 316 ! 317 ! These trends are done every second time step. When 1ts output is selected must go different (2ts) file from standard T-file 318 IF( MOD( kt, 2 ) == 0 ) THEN 319 SELECT CASE( ktrd ) 320 CASE( jptra_xad ) ; CALL iom_put( "ttrd_xad" , ptrdx ) ! x- horizontal advection 321 CALL iom_put( "strd_xad" , ptrdy ) 322 CASE( jptra_yad ) ; CALL iom_put( "ttrd_yad" , ptrdx ) ! y- horizontal advection 323 CALL iom_put( "strd_yad" , ptrdy ) 324 CASE( jptra_zad ) ; CALL iom_put( "ttrd_zad" , ptrdx ) ! z- vertical advection 325 CALL iom_put( "strd_zad" , ptrdy ) 326 IF( ln_linssh ) THEN ! cst volume : adv flux through z=0 surface 327 ALLOCATE( z2dx(jpi,jpj) , z2dy(jpi,jpj) ) 328 z2dx(:,:) = wn(:,:,1) * tsn(:,:,1,jp_tem) / e3t_n(:,:,1) 329 z2dy(:,:) = wn(:,:,1) * tsn(:,:,1,jp_sal) / e3t_n(:,:,1) 330 CALL iom_put( "ttrd_sad", z2dx ) 331 CALL iom_put( "strd_sad", z2dy ) 332 DEALLOCATE( z2dx, z2dy ) 333 ENDIF 334 CASE( jptra_totad ) ; CALL iom_put( "ttrd_totad", ptrdx ) ! total advection 335 CALL iom_put( "strd_totad", ptrdy ) 336 CASE( jptra_ldf ) ; CALL iom_put( "ttrd_ldf" , ptrdx ) ! lateral diffusion 337 CALL iom_put( "strd_ldf" , ptrdy ) 338 CASE( jptra_zdf ) ; CALL iom_put( "ttrd_zdf" , ptrdx ) ! vertical diffusion (including Kz contribution) 339 CALL iom_put( "strd_zdf" , ptrdy ) 340 CASE( jptra_zdfp ) ; CALL iom_put( "ttrd_zdfp" , ptrdx ) ! PURE vertical diffusion (no isoneutral contribution) 341 CALL iom_put( "strd_zdfp" , ptrdy ) 342 CASE( jptra_evd ) ; CALL iom_put( "ttrd_evd" , ptrdx ) ! EVD trend (convection) 343 CALL iom_put( "strd_evd" , ptrdy ) 344 CASE( jptra_dmp ) ; CALL iom_put( "ttrd_dmp" , ptrdx ) ! internal restoring (damping) 345 CALL iom_put( "strd_dmp" , ptrdy ) 346 CASE( jptra_bbl ) ; CALL iom_put( "ttrd_bbl" , ptrdx ) ! bottom boundary layer 347 CALL iom_put( "strd_bbl" , ptrdy ) 348 CASE( jptra_npc ) ; CALL iom_put( "ttrd_npc" , ptrdx ) ! static instability mixing 349 CALL iom_put( "strd_npc" , ptrdy ) 350 CASE( jptra_bbc ) ; CALL iom_put( "ttrd_bbc" , ptrdx ) ! geothermal heating (only on temperature) 351 CASE( jptra_nsr ) ; CALL iom_put( "ttrd_qns" , ptrdx(:,:,1) ) ! surface forcing + runoff (ln_rnf=T) 352 CALL iom_put( "strd_cdt" , ptrdy(:,:,1) ) ! output as 2D surface fields 353 CASE( jptra_qsr ) ; CALL iom_put( "ttrd_qsr" , ptrdx ) ! penetrative solar radiat. (only on temperature) 354 END SELECT 355 ! the Asselin filter trend is also every other time step but needs to be lagged one time step 356 ! Even when 1ts output is selected can go to the same (2ts) file as the trends plotted every even time step. 357 ELSEIF( MOD( kt, 2 ) == 1 ) THEN 358 SELECT CASE( ktrd ) 359 CASE( jptra_atf ) ; CALL iom_put( "ttrd_atf" , ptrdx ) ! asselin time Filter 360 CALL iom_put( "strd_atf" , ptrdy ) 361 END SELECT 362 ENDIF 363 ! 353 364 END SUBROUTINE trd_tra_iom 354 365 -
branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90
r7881 r8850 28 28 USE oce_trc ! ocean dynamics and tracers variables 29 29 USE trc ! ocean passive tracers variables 30 USE lbclnk ! ocean lateral boundary conditions (or mpp link)31 USE prtctl_trc ! Print control for debbuging32 30 USE trd_oce 33 31 USE trdtra … … 38 36 USE agrif_top_interp 39 37 # endif 38 ! 39 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 40 USE prtctl_trc ! Print control for debbuging 40 41 41 42 IMPLICIT NONE 42 43 PRIVATE 43 44 44 PUBLIC trc_nxt 45 PUBLIC trc_nxt ! routine called by step.F90 45 46 46 47 REAL(wp) :: rfact1, rfact2 … … 82 83 REAL(wp) :: zfact ! temporary scalar 83 84 CHARACTER (len=22) :: charout 84 REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrdt85 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrdt ! 4D workspace 85 86 !!---------------------------------------------------------------------- 86 87 ! … … 102 103 103 104 IF( l_trdtrc ) THEN ! trends: store now fields before the Asselin filter application 104 CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt)105 ALLOCATE( ztrdt(jpi,jpj,jpk,jptra) ) 105 106 ztrdt(:,:,:,:) = trn(:,:,:,:) 106 107 ENDIF … … 137 138 END DO 138 139 END DO 139 CALL wrk_dealloc( jpi, jpj, jpk, jptra,ztrdt )140 DEALLOCATE( ztrdt ) 140 141 END IF 141 142 !
Note: See TracChangeset
for help on using the changeset viewer.
