Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90
r2528 r2715 24 24 USE trdmld ! ocean active mixed layer tracers trends 25 25 USE in_out_manager ! I/O manager 26 USE lib_mpp ! MPP library 26 27 27 28 IMPLICIT NONE … … 39 40 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 40 41 !! $Id$ 41 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)42 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 42 43 !!---------------------------------------------------------------------- 43 44 … … 51 52 !! integral constraints 52 53 !!---------------------------------------------------------------------- 53 INTEGER, INTENT( in ) :: kt ! time step 54 INTEGER, INTENT( in ) :: ktrd ! tracer trend index 55 CHARACTER(len=3), INTENT( in ) :: ctype ! momentum or tracers trends type 'DYN'/'TRA' 56 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: ptrdx ! Temperature or U trend 57 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( inout ) :: ptrdy ! Salinity or V trend 54 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 55 USE wrk_nemo, ONLY: ztswu => wrk_2d_1, & 56 ztswv => wrk_2d_2, & 57 ztbfu => wrk_2d_3, & 58 ztbfv => wrk_2d_4, & 59 z2dx => wrk_2d_5, & 60 z2dy => wrk_2d_6 61 ! 62 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdx ! Temperature or U trend 63 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: ptrdy ! Salinity or V trend 64 CHARACTER(len=3) , INTENT(in ) :: ctype ! momentum or tracers trends type 'DYN'/'TRA' 65 INTEGER , INTENT(in ) :: kt ! time step 66 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 58 67 !! 59 INTEGER :: ji, jj 60 REAL(wp), DIMENSION(jpi,jpj) :: ztswu, ztswv ! 2D workspace 61 REAL(wp), DIMENSION(jpi,jpj) :: ztbfu, ztbfv ! 2D workspace 62 REAL(wp), DIMENSION(jpi,jpj) :: z2dx, z2dy ! workspace arrays 63 !!---------------------------------------------------------------------- 64 65 z2dx(:,:) = 0.e0 ; z2dy(:,:) = 0.e0 ! initialization of workspace arrays 66 67 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra (restarting with Euler time stepping) 68 ELSEIF( kt <= nit000 + 1) THEN ; r2dt = 2. * rdt ! = 2 rdttra (leapfrog) 68 INTEGER :: ji, jj ! dummy loop indices 69 !!---------------------------------------------------------------------- 70 71 IF(wrk_in_use(2, 1,2,3,4,5,6))THEN 72 CALL ctl_warn('trd_mod: Requested workspace arrays already in use.') ; RETURN 73 END IF 74 75 z2dx(:,:) = 0._wp ; z2dy(:,:) = 0._wp ! initialization of workspace arrays 76 77 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra (restart with Euler time stepping) 78 ELSEIF( kt <= nit000 + 1) THEN ; r2dt = 2. * rdt ! = 2 rdttra (leapfrog) 69 79 ENDIF 70 80 … … 84 94 CASE ( jptra_trd_dmp ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_dmp, ctype ) ! damping 85 95 CASE ( jptra_trd_qsr ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_qsr, ctype ) ! penetrative solar radiat. 86 CASE ( jptra_trd_nsr ) 87 z2dx(:,:) = ptrdx(:,:,1) ;z2dy(:,:) = ptrdy(:,:,1)88 CALL trd_icp( z2dx, z2dy, jpicpt_nsr, ctype )! non solar radiation96 CASE ( jptra_trd_nsr ) ; z2dx(:,:) = ptrdx(:,:,1) 97 z2dy(:,:) = ptrdy(:,:,1) 98 CALL trd_icp( z2dx , z2dy , jpicpt_nsr, ctype ) ! non solar radiation 89 99 CASE ( jptra_trd_xad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_xad, ctype ) ! x- horiz adv 90 100 CASE ( jptra_trd_yad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_yad, ctype ) ! y- horiz adv 91 CASE ( jptra_trd_zad ) 92 CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype )93 ! compute the surface flux condition wn(:,:,1)*tn(:,:,1)94 z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1)95 z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1)96 CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype )! 1st z- vertical adv101 CASE ( jptra_trd_zad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype ) ! z- vertical adv 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 adv 97 107 END SELECT 98 108 END IF … … 113 123 ! subtract surface forcing/bottom friction trends 114 124 ! from vertical diffusive momentum trends 115 ztswu(:,:) = 0. e0 ; ztswv(:,:) = 0.e0116 ztbfu(:,:) = 0. e0 ; ztbfv(:,:) = 0.e0125 ztswu(:,:) = 0._wp ; ztswv(:,:) = 0._wp 126 ztbfu(:,:) = 0._wp ; ztbfv(:,:) = 0._wp 117 127 DO jj = 2, jpjm1 118 128 DO ji = fs_2, fs_jpim1 ! vector opt. … … 121 131 ztswv(ji,jj) = vtau(ji,jj) / ( fse3v(ji,jj,1)*rau0 ) 122 132 ! bottom friction contribution now handled explicitly 123 ! 124 ptrdx(ji,jj,1 ) = ptrdx(ji,jj,1 ) - ztswu(ji,jj) 125 ptrdy(ji,jj,1 ) = ptrdy(ji,jj,1 ) - ztswv(ji,jj) 133 ptrdx(ji,jj,1) = ptrdx(ji,jj,1) - ztswu(ji,jj) 134 ptrdy(ji,jj,1) = ptrdy(ji,jj,1) - ztswv(ji,jj) 126 135 END DO 127 136 END DO … … 218 227 ENDIF 219 228 ! 229 IF( wrk_not_released(2, 1,2,3,4,5,6) ) CALL ctl_warn('trd_mod: Failed to release workspace arrays.') 230 ! 220 231 END SUBROUTINE trd_mod 221 232 … … 228 239 USE trdicp ! ocean bassin integral constraints properties 229 240 USE trdmld ! ocean active mixed layer tracers trends 230 241 !!---------------------------------------------------------------------- 231 242 CONTAINS 232 243 SUBROUTINE trd_mod(ptrd3dx, ptrd3dy, ktrd , ctype, kt ) ! Empty routine 233 REAL 234 INTEGER :: ktrd, kt244 REAL(wp) :: ptrd3dx(:,:,:), ptrd3dy(:,:,:) 245 INTEGER :: ktrd, kt 235 246 CHARACTER(len=3) :: ctype 236 247 WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd3dx(1,1,1), ptrd3dy(1,1,1)
Note: See TracChangeset
for help on using the changeset viewer.
