Changeset 2613 for branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD
- Timestamp:
- 2011-02-25T11:45:57+01:00 (13 years ago)
- Location:
- branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD
- Files:
-
- 3 edited
-
trdmld.F90 (modified) (5 diffs)
-
trdmld_oce.F90 (modified) (4 diffs)
-
trdmod.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90
r2590 r2613 72 72 INTEGER :: trd_mld_alloc 73 73 !!---------------------------------------------------------------------- 74 74 ! 75 75 ALLOCATE(ndextrd1(jpi*jpj), Stat=trd_mld_alloc) 76 77 IF(trd_mld_alloc /= 0)THEN 78 CALL ctl_warn('trd_mld_alloc: failed to allocate array ndextrd1.') 79 END IF 80 76 ! 77 IF( trd_mld_alloc /= 0 ) CALL ctl_warn('trd_mld_alloc: failed to allocate array ndextrd1.') 78 ! 81 79 END FUNCTION trd_mld_alloc 80 82 81 83 82 SUBROUTINE trd_mld_zint( pttrdmld, pstrdmld, ktrd, ctype ) … … 262 261 USE wrk_nemo, ONLY: ztmltot2 => wrk_2d_7, ztmlres2 => wrk_2d_8, ztmltrdm2 => wrk_2d_9 ! \ working arrays to diagnose the trends 263 262 USE wrk_nemo, ONLY: zsmltot2 => wrk_2d_10, zsmlres2 => wrk_2d_11, zsmltrdm2 => wrk_2d_12 ! > associated with the time meaned ML T & S 264 USE wrk_nemo, ONLY: ztmlatf2 => wrk_2d_13, zsmlatf2 => wrk_2d_14 ! / 263 USE wrk_nemo, ONLY: ztmlatf2 => wrk_2d_13, zsmlatf2 => wrk_2d_14 264 USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2 ! / 265 265 !! 266 266 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 269 269 LOGICAL :: lldebug = .TRUE. 270 270 REAL(wp) :: zavt, zfn, zfn2 271 REAL(wp), POINTER, DIMENSION(:,:,:) :: & 272 ztmltrd2, zsmltrd2 ! only needed for mean diagnostics 271 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmltrd2, zsmltrd2 ! only needed for mean diagnostics 273 272 #if defined key_dimgout 274 273 INTEGER :: iyear,imon,iday … … 282 281 CALL ctl_stop('trd_mld : requested workspace arrays unavailable.') 283 282 RETURN 284 ELSE IF(jpltrd > jpk) 283 ELSE IF(jpltrd > jpk) THEN 285 284 ! ARPDBG, is this reasonable or will this cause trouble in the future? 286 285 CALL ctl_stop('trd_mld : no. of mixed-layer trends (jpltrd) exceeds no. of model levels so cannot use 3D workspaces.') … … 288 287 END IF 289 288 ! Set-up pointers into sub-arrays of 3d-workspaces 290 ztmltrd2 => wrk_3d_1( :,:,1:jpltrd)291 zsmltrd2 => wrk_3d_2( :,:,1:jpltrd)289 ztmltrd2 => wrk_3d_1(1:,:,1:jpltrd) 290 zsmltrd2 => wrk_3d_2(1:,:,1:jpltrd) 292 291 293 292 ! ====================================================================== -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld_oce.F90
r2590 r2613 71 71 tmlatfm, smlatfm !: accumulator for Asselin trends (needed for storage only) 72 72 73 REAL(wp), PUBLIC, DIMENSION(:,:,:) :: &73 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:,:) :: & 74 74 tmltrd, & !: \ physical contributions to the total trend (for T/S), 75 75 smltrd, & !: / cumulated over the current analysis window … … 82 82 #endif 83 83 !!---------------------------------------------------------------------- 84 !! NEMO/OPA 3.3 , NEMO Consortium (2010)84 !! NEMO/OPA 4.0 , NEMO Consortium (2011) 85 85 !! $Id$ 86 86 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 87 !! ======================================================================87 !!---------------------------------------------------------------------- 88 88 CONTAINS 89 89 … … 92 92 !!---------------------------------------------------------------------- 93 93 USE in_out_manager, ONLY: ctl_warn 94 IMPLICIT none95 94 INTEGER :: trdmld_oce_alloc 96 95 INTEGER :: ierr(5) … … 104 103 105 104 #if defined key_trdmld || defined key_esopa 106 ALLOCATE( nmld(jpi,jpj), nbol(jpi,jpj), &107 wkx(jpi,jpj,jpk), rmld(jpi,jpj), &108 tml(jpi,jpj) , sml(jpi,jpj), &109 tmlb(jpi,jpj) , smlb(jpi,jpj) , &110 tmlbb(jpi,jpj) , smlbb(jpi,jpj), &111 Stat = ierr(1))105 ALLOCATE( nmld(jpi,jpj), nbol(jpi,jpj), & 106 & wkx(jpi,jpj,jpk), rmld(jpi,jpj), & 107 & tml(jpi,jpj) , sml(jpi,jpj), & 108 & tmlb(jpi,jpj) , smlb(jpi,jpj) , & 109 & tmlbb(jpi,jpj) , smlbb(jpi,jpj), & 110 & Stat = ierr(1)) 112 111 113 ALLOCATE( tmlbn(jpi,jpj) , smlbn(jpi,jpj), &114 tmltrdm(jpi,jpj), smltrdm(jpi,jpj), &115 tml_sum(jpi,jpj), tml_sumb(jpi,jpj),&116 tmltrd_atf_sumb(jpi,jpj), Stat=ierr(2))112 ALLOCATE( tmlbn(jpi,jpj) , smlbn(jpi,jpj), & 113 & tmltrdm(jpi,jpj), smltrdm(jpi,jpj), & 114 & tml_sum(jpi,jpj), tml_sumb(jpi,jpj),& 115 & tmltrd_atf_sumb(jpi,jpj), Stat=ierr(2)) 117 116 118 ALLOCATE( sml_sum(jpi,jpj), sml_sumb(jpi,jpj), &119 smltrd_atf_sumb(jpi,jpj), &120 rmld_sum(jpi,jpj), rmldbn(jpi,jpj), &121 tmlatfb(jpi,jpj), tmlatfn(jpi,jpj), &122 Stat = ierr(3))117 ALLOCATE( sml_sum(jpi,jpj), sml_sumb(jpi,jpj), & 118 & smltrd_atf_sumb(jpi,jpj), & 119 & rmld_sum(jpi,jpj), rmldbn(jpi,jpj), & 120 & tmlatfb(jpi,jpj), tmlatfn(jpi,jpj), & 121 & Stat = ierr(3)) 123 122 124 ALLOCATE( smlatfb(jpi,jpj), smlatfn(jpi,jpj), &125 tmlatfm(jpi,jpj), smlatfm(jpi,jpj), &126 tmltrd(jpi,jpj,jpltrd), smltrd(jpi,jpj,jpltrd), &127 Stat=ierr(4))123 ALLOCATE( smlatfb(jpi,jpj), smlatfn(jpi,jpj), & 124 & tmlatfm(jpi,jpj), smlatfm(jpi,jpj), & 125 & tmltrd(jpi,jpj,jpltrd), smltrd(jpi,jpj,jpltrd), & 126 & Stat=ierr(4)) 128 127 129 ALLOCATE( tmltrd_sum(jpi,jpj,jpltrd),tmltrd_csum_ln(jpi,jpj,jpltrd), &130 tmltrd_csum_ub(jpi,jpj,jpltrd), smltrd_sum(jpi,jpj,jpltrd), &131 smltrd_csum_ln(jpi,jpj,jpltrd), smltrd_csum_ub(jpi,jpj,jpltrd), &132 Stat=ierr(5))128 ALLOCATE( tmltrd_sum(jpi,jpj,jpltrd),tmltrd_csum_ln(jpi,jpj,jpltrd), & 129 & tmltrd_csum_ub(jpi,jpj,jpltrd), smltrd_sum(jpi,jpj,jpltrd), & 130 & smltrd_csum_ln(jpi,jpj,jpltrd), smltrd_csum_ub(jpi,jpj,jpltrd), & 131 & Stat=ierr(5)) 133 132 #endif 133 ! 134 trdmld_oce_alloc = MAXVAL(ierr) 135 ! 136 IF( trdmld_oce_alloc /= 0 ) CALL ctl_warn('trdmld_oce_alloc: failed to allocate arrays.') 137 ! 138 END FUNCTION trdmld_oce_alloc 134 139 135 trdmld_oce_alloc = MAXVAL(ierr) 136 137 IF(trdmld_oce_alloc /= 0)THEN 138 CALL ctl_warn('trdmld_oce_alloc: failed to allocate arrays.') 139 END IF 140 141 END FUNCTION trdmld_oce_alloc 142 140 !!====================================================================== 143 141 END MODULE trdmld_oce -
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90
r2590 r2613 58 58 z2dx => wrk_2d_5, & 59 59 z2dy => wrk_2d_6 60 IMPLICIT none61 INTEGER, INTENT( in ) :: kt ! time step62 INTEGER, INTENT( in ) :: ktrd ! tracer trend index63 CHARACTER(len=3) , INTENT( in ) :: ctype! momentum or tracers trends type 'DYN'/'TRA'64 REAL(wp), DIMENSION(:,:,:), INTENT( inout ) :: ptrdx ! Temperature or U trend65 REAL(wp), DIMENSION(:,:,:), INTENT( inout ) :: ptrdy ! Salinity or V trend60 ! 61 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdx ! Temperature or U trend 62 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdy ! Salinity or V trend 63 CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum or tracers trends type 'DYN'/'TRA' 64 INTEGER , INTENT(in ) :: kt ! time step 65 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 66 66 !! 67 INTEGER :: ji, jj 67 INTEGER :: ji, jj ! dummy loop indices 68 68 !!---------------------------------------------------------------------- 69 69 70 70 IF(.not. wrk_use(2, 1,2,3,4,5,6))THEN 71 CALL ctl_error('trd_mod: Requested workspace arrays already in use.') 72 RETURN 71 CALL ctl_warn('trd_mod: Requested workspace arrays already in use.') ; RETURN 73 72 END IF 74 73 75 z2dx(:,:) = 0.e0 ; z2dy(:,:) = 0.e0! initialization of workspace arrays76 77 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra (restartingwith Euler time stepping)78 ELSEIF( kt <= nit000 + 1) THEN ; r2dt = 2. * rdt 74 z2dx(:,:) = 0._wp ; z2dy(:,:) = 0._wp ! initialization of workspace arrays 75 76 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra (restart with Euler time stepping) 77 ELSEIF( kt <= nit000 + 1) THEN ; r2dt = 2. * rdt ! = 2 rdttra (leapfrog) 79 78 ENDIF 80 79 … … 94 93 CASE ( jptra_trd_dmp ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_dmp, ctype ) ! damping 95 94 CASE ( jptra_trd_qsr ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_qsr, ctype ) ! penetrative solar radiat. 96 CASE ( jptra_trd_nsr ) 97 z2dx(:,:) = ptrdx(:,:,1) ;z2dy(:,:) = ptrdy(:,:,1)98 CALL trd_icp( z2dx, z2dy, jpicpt_nsr, ctype )! non solar radiation95 CASE ( jptra_trd_nsr ) ; z2dx(:,:) = ptrdx(:,:,1) 96 z2dy(:,:) = ptrdy(:,:,1) 97 CALL trd_icp( z2dx , z2dy , jpicpt_nsr, ctype ) ! non solar radiation 99 98 CASE ( jptra_trd_xad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_xad, ctype ) ! x- horiz adv 100 99 CASE ( jptra_trd_yad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_yad, ctype ) ! y- horiz adv 101 CASE ( jptra_trd_zad ) 102 CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype )103 ! compute the surface flux condition wn(:,:,1)*tn(:,:,1)104 z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1)105 z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1)106 CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype )! 1st z- vertical adv100 CASE ( jptra_trd_zad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype ) ! z- vertical adv 101 CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype ) 102 ! compute the surface flux condition wn(:,:,1)*tn(:,:,1) 103 z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1) 104 z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1) 105 CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype ) ! 1st z- vertical adv 107 106 END SELECT 108 107 END IF … … 123 122 ! subtract surface forcing/bottom friction trends 124 123 ! from vertical diffusive momentum trends 125 ztswu(:,:) = 0. e0 ; ztswv(:,:) = 0.e0126 ztbfu(:,:) = 0. e0 ; ztbfv(:,:) = 0.e0124 ztswu(:,:) = 0._wp ; ztswv(:,:) = 0._wp 125 ztbfu(:,:) = 0._wp ; ztbfv(:,:) = 0._wp 127 126 DO jj = 2, jpjm1 128 127 DO ji = fs_2, fs_jpim1 ! vector opt. … … 131 130 ztswv(ji,jj) = vtau(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) 132 131 ! bottom friction contribution now handled explicitly 133 ! 134 ptrdx(ji,jj,1 ) = ptrdx(ji,jj,1 ) - ztswu(ji,jj) 135 ptrdy(ji,jj,1 ) = ptrdy(ji,jj,1 ) - ztswv(ji,jj) 132 ptrdx(ji,jj,1) = ptrdx(ji,jj,1) - ztswu(ji,jj) 133 ptrdy(ji,jj,1) = ptrdy(ji,jj,1) - ztswv(ji,jj) 136 134 END DO 137 135 END DO … … 228 226 ENDIF 229 227 ! 230 IF(.not. wrk_release(2, 1,2,3,4,5,6))THEN 231 CALL ctl_error('trd_mod: Failed to release workspace arrays.') 232 END IF 228 IF( .not. wrk_release(2, 1,2,3,4,5,6) ) CALL ctl_warn('trd_mod: Failed to release workspace arrays.') 233 229 ! 234 230 END SUBROUTINE trd_mod … … 242 238 USE trdicp ! ocean bassin integral constraints properties 243 239 USE trdmld ! ocean active mixed layer tracers trends 244 240 !!---------------------------------------------------------------------- 245 241 CONTAINS 246 242 SUBROUTINE trd_mod(ptrd3dx, ptrd3dy, ktrd , ctype, kt ) ! Empty routine
Note: See TracChangeset
for help on using the changeset viewer.
