Changeset 521 for trunk/NEMO/OPA_SRC/TRD
- Timestamp:
- 2006-10-11T16:45:09+02:00 (18 years ago)
- Location:
- trunk/NEMO/OPA_SRC/TRD
- Files:
-
- 4 edited
-
trdicp.F90 (modified) (1 diff)
-
trdmld.F90 (modified) (4 diffs)
-
trdmld_rst.F90 (modified) (4 diffs)
-
trdmod.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/TRD/trdicp.F90
r503 r521 702 702 !!---------------------------------------------------------------------- 703 703 CONTAINS 704 SUBROUTINE trd_2d( ptrd2dx, ptrd2dy, ktrd , ctype ) ! Empty routine704 SUBROUTINE trd_2d( ptrd2dx, ptrd2dy, ktrd , ctype, clpas ) ! Empty routine 705 705 REAL, DIMENSION(:,:) :: ptrd2dx, ptrd2dy 706 WRITE(*,*) 'trd_2d: You should not have seen this print! error ?', ptrd2dx(1,1), ptrd2dy(1,1), ktrd, ctype 706 CHARACTER(len=3), INTENT(in), OPTIONAL :: clpas ! number of passage 707 WRITE(*,*) 'trd_2d: You should not have seen this print! error ?', & 708 & ptrd2dx(1,1), ptrd2dy(1,1), ktrd, ctype, clpas 707 709 END SUBROUTINE trd_2d 708 SUBROUTINE trd_3d( ptrd3dx, ptrd3dy, ktrd , ctype ) ! Empty routine710 SUBROUTINE trd_3d( ptrd3dx, ptrd3dy, ktrd , ctype, clpas ) ! Empty routine 709 711 REAL, DIMENSION(:,:,:) :: ptrd3dx, ptrd3dy 710 WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', ptrd3dx(1,1,1), ptrd3dy(1,1,1), ktrd, ctype 712 CHARACTER(len=3), INTENT(in), OPTIONAL :: clpas ! number of passage 713 WRITE(*,*) 'trd_3d: You should not have seen this print! error ?', & 714 & ptrd3dx(1,1,1), ptrd3dy(1,1,1), ktrd, ctype, clpas 711 715 END SUBROUTINE trd_3d 712 716 SUBROUTINE trd_icp_init ! Empty routine -
trunk/NEMO/OPA_SRC/TRD/trdmld.F90
r503 r521 35 35 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 36 36 USE diadimg ! dimg direct access file format output 37 USE trdmld_rst , ONLY : trd_mld_rst_read! restart for diagnosing the ML trends37 USE trdmld_rst ! restart for diagnosing the ML trends 38 38 USE prtctl ! Print control 39 39 … … 230 230 !! 231 231 INTEGER :: ji, jj, jk, jl, ik, it 232 LOGICAL :: lldebug = . TRUE.232 LOGICAL :: lldebug = .FALSE. 233 233 REAL(wp) :: zavt, zfn, zfn2 234 234 REAL(wp) ,DIMENSION(jpi,jpj) :: & … … 253 253 ! ... These terms can be estimated by flux computation at the lower boundary of the ML 254 254 ! (we compute (-1/h) * K_z * d_z( T ) and (-1/h) * K_z * d_z( S )) 255 DO jj = 1,jpj256 DO ji = 1,jpi257 ik = nmld(ji,jj)258 zavt = avt(ji,jj,ik)259 tmltrd(ji,jj,jpmld_zdf) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik) &260 & * ( tn(ji,jj,ik-1) - tn(ji,jj,ik) ) &261 & / MAX( 1., rmld(ji,jj) ) * tmask(ji,jj,1)262 zavt = fsavs(ji,jj,ik)263 smltrd(ji,jj,jpmld_zdf) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik) &264 & * ( sn(ji,jj,ik-1) - sn(ji,jj,ik) ) &265 & / MAX( 1., rmld(ji,jj) ) * tmask(ji,jj,1)266 END DO267 END DO268 269 ! ... Remove this K_z trend from the iso-neutral diffusion term (if any)270 255 IF( ln_traldf_iso ) THEN 256 DO jj = 1,jpj 257 DO ji = 1,jpi 258 ik = nmld(ji,jj) 259 zavt = avt(ji,jj,ik) 260 tmltrd(ji,jj,jpmld_zdf) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik) & 261 & * ( tn(ji,jj,ik-1) - tn(ji,jj,ik) ) & 262 & / MAX( 1., rmld(ji,jj) ) * tmask(ji,jj,1) 263 zavt = fsavs(ji,jj,ik) 264 smltrd(ji,jj,jpmld_zdf) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik) & 265 & * ( sn(ji,jj,ik-1) - sn(ji,jj,ik) ) & 266 & / MAX( 1., rmld(ji,jj) ) * tmask(ji,jj,1) 267 END DO 268 END DO 269 270 ! ... Remove this K_z trend from the iso-neutral diffusion term (if any) 271 271 tmltrd(:,:,jpmld_ldf) = tmltrd(:,:,jpmld_ldf) - tmltrd(:,:,jpmld_zdf) 272 272 smltrd(:,:,jpmld_ldf) = smltrd(:,:,jpmld_ldf) - smltrd(:,:,jpmld_zdf) … … 698 698 END IF 699 699 700 ! ====================================================================== 701 ! V. Write restart file 702 ! ====================================================================== 703 704 CALL trd_mld_rst_write( kt ) 705 700 706 END SUBROUTINE trd_mld 701 707 -
trunk/NEMO/OPA_SRC/TRD/trdmld_rst.F90
r503 r521 12 12 USE in_out_manager ! I/O manager 13 13 USE daymod ! calendar 14 USE ioipsl ! 14 USE iom ! I/O module 15 USE restart ! ocean restart 15 16 16 17 IMPLICIT NONE … … 32 33 !! 33 34 !! ** Purpose : Write mixed-layer diagnostics restart fields. 34 !!-------------------------------------------------------------------------------- ---35 !!-------------------------------------------------------------------------------- 35 36 INTEGER, INTENT( in ) :: kt ! ocean time-step index 36 !! 37 LOGICAL :: llbon 38 CHARACTER (len=50) :: clname, cln 39 REAL(wp) :: zdate0 40 REAL(wp), DIMENSION(1) :: zdept 41 INTEGER :: ic, jc, itime, inumwrs_mld 42 !!----------------------------------------------------------------------------- 37 ! 38 CHARACTER (len=35) :: charout 39 INTEGER :: jk ! loop indice 40 !!-------------------------------------------------------------------------------- 43 41 44 42 IF( ( mod( kt, nstock ) == 0 ) .OR. ( kt == nitend ) ) THEN 45 43 46 inumwrs_mld = 4747 !-- Delete the restart file if it exists48 INQUIRE( FILE=crestart, EXIST=llbon )49 IF(llbon) THEN50 OPEN( UNIT=inumwrs_mld, FILE=crestart, STATUS='old' )51 CLOSE( inumwrs_mld, STATUS='delete' )52 ENDIF53 54 !-- Name of the new restart file55 ic = 156 DO jc = 1, 1657 IF( cexper(jc:jc) /= ' ' ) ic = jc58 END DO59 WRITE(cln,'("_",i4.4,i2.2,i2.2,"_restart_mld")') nyear, nmonth, nday60 clname = cexper(1:ic)//cln61 ic = 162 DO jc = 1, 4863 IF( clname(jc:jc) /= ' ' ) ic = jc64 END DO65 crestart = clname(1:ic)//".nc"66 itime = 067 CALL ymds2ju( nyear, nmonth, nday, 0.e0, zdate0 )68 69 44 IF(lwp) THEN 70 45 WRITE(numout,*) 71 46 WRITE(numout,*) 'trdmld_rst: output for ML diags. restart, with trd_mld_rst_write routine' 72 47 WRITE(numout,*) '~~~~~~~~~~' 73 WRITE(numout,*) ' in file : ', TRIM(crestart), ' at it= ', kt, ' date= ', ndastp74 48 WRITE(numout,*) 75 49 ENDIF 76 50 77 !-- Create the NetCDF restart file and write tje appropriate fields78 ! N.B. In this section, 3rd dimension in arrays is NOT depth79 zdept(1) = 1.80 CALL restini( 'NONE', jpi, jpj, glamt, gphit, 1, zdept, clname, &81 & itime, zdate0, rdt*nstock ,inumwrs_mld, domain_id=nidom )82 83 51 IF( ln_trdmld_instant ) THEN 84 CALL restput( inumwrs_mld, 'tmlbb' , jpi, jpj, 1, 0, tmlbb ) 85 CALL restput( inumwrs_mld, 'tmlbn' , jpi, jpj, 1, 0, tmlbn ) 86 CALL restput( inumwrs_mld, 'tmlatfb' , jpi, jpj, 1, 0, tmlatfb ) 52 !-- Temperature 53 CALL iom_rstput( kt, nitrst, nummldw, 'tmlbb' , tmlbb ) 54 CALL iom_rstput( kt, nitrst, nummldw, 'tmlbn' , tmlbn ) 55 CALL iom_rstput( kt, nitrst, nummldw, 'tmlatfb' , tmlatfb ) 87 56 88 CALL restput( inumwrs_mld, 'smlbb' , jpi, jpj, 1, 0, smlbb ) 89 CALL restput( inumwrs_mld, 'smlbn' , jpi, jpj, 1, 0, smlbn ) 90 CALL restput( inumwrs_mld, 'smlatfb' , jpi, jpj, 1, 0, smlatfb ) 57 !-- Salinity 58 CALL iom_rstput( kt, nitrst, nummldw, 'smlbb' , smlbb ) 59 CALL iom_rstput( kt, nitrst, nummldw, 'smlbn' , smlbn ) 60 CALL iom_rstput( kt, nitrst, nummldw, 'smlatfb' , smlatfb ) 91 61 ELSE 92 CALL restput( inumwrs_mld, 'rmldbn' , jpi, jpj, 1, 0, rmldbn )62 CALL iom_rstput( kt, nitrst, nummldw, 'rmldbn' , rmldbn ) 93 63 94 64 !-- Temperature 95 CALL restput( inumwrs_mld, 'tmlbn' , jpi, jpj, 1, 0, tmlbn ) 96 CALL restput( inumwrs_mld, 'tml_sumb' , jpi, jpj, 1, 0, tml_sumb ) 97 CALL restput( inumwrs_mld, 'tmltrd_csum_ub' , jpi, jpj, jpltrd, 0, tmltrd_csum_ub ) 98 CALL restput( inumwrs_mld, 'tmltrd_atf_sumb' , jpi, jpj, 1, 0, tmltrd_atf_sumb ) 65 CALL iom_rstput( kt, nitrst, nummldw, 'tmlbn' , tmlbn ) 66 CALL iom_rstput( kt, nitrst, nummldw, 'tml_sumb' , tml_sumb ) 67 DO jk = 1, jpltrd 68 IF( jk < 10 ) THEN 69 WRITE(charout,FMT="('tmltrd_csum_ub_', I1)") jk 70 ELSE 71 WRITE(charout,FMT="('tmltrd_csum_ub_', I2)") jk 72 ENDIF 73 CALL iom_rstput( kt, nitrst, nummldw, charout, tmltrd_csum_ub(:,:,jk) ) 74 ENDDO 75 CALL iom_rstput( kt, nitrst, nummldw, 'tmltrd_atf_sumb' , tmltrd_atf_sumb ) 99 76 100 77 !-- Salinity 101 CALL restput( inumwrs_mld, 'smlbn' , jpi, jpj, 1, 0, smlbn ) 102 CALL restput( inumwrs_mld, 'sml_sumb' , jpi, jpj, 1, 0, sml_sumb ) 103 CALL restput( inumwrs_mld, 'smltrd_csum_ub' , jpi, jpj, jpltrd, 0, smltrd_csum_ub ) 104 CALL restput( inumwrs_mld, 'smltrd_atf_sumb' , jpi, jpj, 1, 0, smltrd_atf_sumb ) 78 CALL iom_rstput( kt, nitrst, nummldw, 'smlbn' , smlbn ) 79 CALL iom_rstput( kt, nitrst, nummldw, 'sml_sumb' , sml_sumb ) 80 DO jk = 1, jpltrd 81 IF( jk < 10 ) THEN 82 WRITE(charout,FMT="('smltrd_csum_ub_', I1)") jk 83 ELSE 84 WRITE(charout,FMT="('smltrd_csum_ub_', I2)") jk 85 ENDIF 86 CALL iom_rstput( kt, nitrst, nummldw, charout , smltrd_csum_ub(:,:,jk) ) 87 ENDDO 88 CALL iom_rstput( kt, nitrst, nummldw, 'smltrd_atf_sumb' , smltrd_atf_sumb ) 105 89 ENDIF 106 90 ! 107 CALL restclo( inumwrs_mld)91 CALL iom_close( nummldw ) ! close the restart file (only at last time step) 108 92 ! 109 93 ENDIF … … 118 102 !! ** Purpose : Read file for mixed-layer diagnostics restart. 119 103 !!---------------------------------------------------------------------------- 120 LOGICAL :: llog 121 REAL(wp) :: zlamt(jpi,jpj), zphit(jpi,jpj) 122 CHARACTER (len=8 ) :: clvnames(30) 123 CHARACTER (len=32) :: clname = 'restart_mld' 124 INTEGER :: itime, ibvar, & 125 inum ! temporary logical unit 126 REAL(wp) :: zdate0, zdt 127 REAL(wp), DIMENSION(1) :: zdept 104 INTEGER :: inum ! temporary logical unit 105 ! 106 CHARACTER (len=35) :: charout 107 INTEGER :: jk ! loop indice 128 108 !!----------------------------------------------------------------------------- 129 109 … … 134 114 ENDIF 135 115 136 itime = 0 137 llog = .FALSE. 138 zlamt(:,:) = 0.e0 ; zphit(:,:) = 0.e0 ; zdept(1) = 0.e0 139 CALL restini( clname, jpi, jpj, zlamt, zphit, 1, zdept, 'NONE', & 140 & itime, zdate0, zdt, inum, domain_id=nidom ) 141 142 CALL ioget_vname( inum, ibvar, clvnames) 143 144 IF(lwp) THEN 145 WRITE(numout,*) 146 WRITE(numout,*) ' Info on the MLD restart file read : ' 147 WRITE(numout,*) ' File name : ', clname 148 WRITE(numout,*) ' number of variables : ', ibvar 149 WRITE(numout,*) ' NetCDF variables : ', clvnames 150 WRITE(numout,*) 151 ENDIF 116 inum = 10 117 CALL iom_open( 'restart_mld', inum ) ! Open 152 118 153 119 IF( ln_trdmld_instant ) THEN 154 CALL restget( inum, 'tmlbb' , jpi, jpj, 1, 0, llog, tmlbb ) 155 CALL restget( inum, 'tmlbn' , jpi, jpj, 1, 0, llog, tmlbn ) 156 CALL restget( inum, 'tmlatfb' , jpi, jpj, 1, 0, llog, tmlatfb ) 120 !-- Temperature 121 CALL iom_get( inum, jpdom_local, 'tmlbb' , tmlbb ) 122 CALL iom_get( inum, jpdom_local, 'tmlbn' , tmlbn ) 123 CALL iom_get( inum, jpdom_local, 'tmlatfb' , tmlatfb ) 157 124 158 CALL restget( inum, 'smlbb' , jpi, jpj, 1, 0, llog, smlbb ) 159 CALL restget( inum, 'smlbn' , jpi, jpj, 1, 0, llog, smlbn ) 160 CALL restget( inum, 'smlatfb' , jpi, jpj, 1, 0, llog, smlatfb ) 125 !-- Salinity 126 CALL iom_get( inum, jpdom_local, 'smlbb' , smlbb ) 127 CALL iom_get( inum, jpdom_local, 'smlbn' , smlbn ) 128 CALL iom_get( inum, jpdom_local, 'smlatfb' , smlatfb ) 161 129 ELSE 162 CALL restget( inum, 'rmldbn' , jpi, jpj, 1, 0, llog, rmldbn ) ! needed for rmld_sum130 CALL iom_get( inum, jpdom_local, 'rmldbn' , rmldbn ) ! needed for rmld_sum 163 131 164 132 !-- Temperature 165 CALL restget( inum, 'tmlbn' , jpi, jpj, 1, 0, llog, tmlbn ) ! needed for tml_sum 166 CALL restget( inum, 'tml_sumb' , jpi, jpj, 1, 0, llog, tml_sumb ) 167 CALL restget( inum, 'tmltrd_csum_ub' , jpi, jpj, jpltrd, 0, llog, tmltrd_csum_ub ) 168 CALL restget( inum, 'tmltrd_atf_sumb' , jpi, jpj, 1, 0, llog, tmltrd_atf_sumb) 133 CALL iom_get( inum, jpdom_local, 'tmlbn' , tmlbn ) ! needed for tml_sum 134 CALL iom_get( inum, jpdom_local, 'tml_sumb' , tml_sumb ) 135 DO jk = 1, jpltrd 136 IF( jk < 10 ) THEN 137 WRITE(charout,FMT="('tmltrd_csum_ub_', I1)") jk 138 ELSE 139 WRITE(charout,FMT="('tmltrd_csum_ub_', I2)") jk 140 ENDIF 141 CALL iom_get( inum, jpdom_local, charout, tmltrd_csum_ub(:,:,jk) ) 142 ENDDO 143 CALL iom_get( inum, jpdom_local, 'tmltrd_atf_sumb' , tmltrd_atf_sumb) 169 144 170 145 !-- Salinity 171 CALL restget( inum, 'smlbn' , jpi, jpj, 1, 0, llog, smlbn ) ! needed for sml_sum 172 CALL restget( inum, 'sml_sumb' , jpi, jpj, 1, 0, llog, sml_sumb ) 173 CALL restget( inum, 'smltrd_csum_ub' , jpi, jpj, jpltrd, 0, llog, smltrd_csum_ub ) 174 CALL restget( inum, 'smltrd_atf_sumb' , jpi, jpj, 1, 0, llog, smltrd_atf_sumb) 146 CALL iom_get( inum, jpdom_local, 'smlbn' , smlbn ) ! needed for sml_sum 147 CALL iom_get( inum, jpdom_local, 'sml_sumb' , sml_sumb ) 148 DO jk = 1, jpltrd 149 IF( jk < 10 ) THEN 150 WRITE(charout,FMT="('smltrd_csum_ub_', I1)") jk 151 ELSE 152 WRITE(charout,FMT="('smltrd_csum_ub_', I2)") jk 153 ENDIF 154 CALL iom_get( inum, jpdom_local, charout, smltrd_csum_ub(:,:,jk) ) 155 ENDDO 156 CALL iom_get( inum, jpdom_local, 'smltrd_atf_sumb' , smltrd_atf_sumb) 175 157 176 CALL restclo( inum )158 CALL iom_close( inum ) 177 159 ENDIF 178 160 -
trunk/NEMO/OPA_SRC/TRD/trdmod.F90
r507 r521 59 59 INTEGER :: ji, ikbu, ikbum1 60 60 INTEGER :: jj, ikbv, ikbvm1 61 CHARACTER(len=3) :: c lpas ! number of passage61 CHARACTER(len=3) :: ccpas ! number of passage 62 62 REAL(wp) :: zua, zva ! scalars 63 63 REAL(wp), DIMENSION(jpi,jpj) :: ztswu, ztswv ! 2D workspace … … 69 69 70 70 ! Control of optional arguments 71 c lpas = 'fst'72 IF( PRESENT(cnbpas) ) c lpas = cnbpas71 ccpas = 'fst' 72 IF( PRESENT(cnbpas) ) ccpas = cnbpas 73 73 74 74 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdtra (restarting with Euler time stepping) … … 97 97 CASE ( jptra_trd_yad ) ; CALL trd_icp( ptrdx, ptrdy, jpicpt_yad, ctype ) ! y- horiz adv 98 98 CASE ( jptra_trd_zad ) ! z- vertical adv 99 CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype, c lpas )99 CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype, ccpas ) 100 100 ! compute the surface flux condition wn(:,:,1)*tn(:,:,1) 101 z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1) 101 z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1) 102 102 z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1) 103 103 CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype ) ! 1st z- vertical adv … … 214 214 ! - and the iso-neutral diffusion if activated 215 215 ! jptra_trd_zdf : called by trazdf.F90 216 ! * in case of purely vertical diffusion (and not iso-neutral), 217 ! we do not need to store the corresponding trend here, since it 218 ! is recomputed later (at the basis of the ML, see trd_mld) 219 ! * else (iso-neutral case) we store the vertical diffusion component in the 216 ! * in case of iso-neutral diffusion we store the vertical diffusion component in the 220 217 ! lateral trend including the K_z contrib, which will be removed later (see trd_mld) 221 218 !----------------------------------------------------------------------------------------------- … … 228 225 CASE ( jptra_trd_bbl ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_bbl, '3D' ) ! bottom boundary layer 229 226 CASE ( jptra_trd_zdf ) 230 IF( ln_traldf_iso ) CALL trd_mld_zint( ptrdx, ptrdy, jpmld_ldf, '3D' ) ! vertical diffusion (K_z) 227 IF( ln_traldf_iso ) THEN 228 CALL trd_mld_zint( ptrdx, ptrdy, jpmld_ldf, '3D' ) ! vertical diffusion (K_z) 229 ELSE 230 CALL trd_mld_zint( ptrdx, ptrdy, jpmld_zdf, '3D' ) ! vertical diffusion (K_z) 231 ENDIF 231 232 CASE ( jptra_trd_dmp ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_dmp, '3D' ) ! internal 3D restoring (tradmp) 232 233 CASE ( jptra_trd_qsr ) ; CALL trd_mld_zint( ptrdx, ptrdy, jpmld_for, '3D' ) ! air-sea : penetrative sol radiat
Note: See TracChangeset
for help on using the changeset viewer.
