New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 8970 for branches/2017/dev_CNRS_2017/NEMOGCM/NEMO – NEMO

Ignore:
Timestamp:
2017-12-11T10:01:56+01:00 (6 years ago)
Author:
gm
Message:

dev_CNRS_2017: bug correction in GLS + minor updates

Location:
branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r7753 r8970  
    397397      REWIND( numnam_cfg )              ! Namelist namptr in configuration namelist : Poleward transport 
    398398      READ  ( numnam_cfg, namptr, IOSTAT = ios, ERR = 902 ) 
    399 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namptr in configuration namelist', lwp ) 
     399902   IF( ios > 0 ) CALL ctl_nam ( ios , 'namptr in configuration namelist', lwp ) 
    400400      IF(lwm) WRITE ( numond, namptr ) 
    401401 
  • branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r8930 r8970  
    239239         IF( nn_print >= 1 ) THEN 
    240240            WRITE(numout,*) 
    241             WRITE(numout,*) '          conversion local  ==> global i-index domain' 
     241            WRITE(numout,*) '          conversion local  ==> global i-index domain (mig)' 
    242242            WRITE(numout,25)              (mig(ji),ji = 1,jpi) 
    243243            WRITE(numout,*) 
    244244            WRITE(numout,*) '          conversion global ==> local  i-index domain' 
    245             WRITE(numout,*) '             starting index' 
     245            WRITE(numout,*) '             starting index (mi0)' 
    246246            WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo) 
    247             WRITE(numout,*) '             ending index' 
     247            WRITE(numout,*) '             ending index (mi1)' 
    248248            WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo) 
    249249            WRITE(numout,*) 
    250             WRITE(numout,*) '          conversion local  ==> global j-index domain' 
     250            WRITE(numout,*) '          conversion local  ==> global j-index domain (mjg)' 
    251251            WRITE(numout,25)              (mjg(jj),jj = 1,jpj) 
    252252            WRITE(numout,*) 
    253253            WRITE(numout,*) '          conversion global ==> local  j-index domain' 
    254             WRITE(numout,*) '             starting index' 
     254            WRITE(numout,*) '             starting index (mj0)' 
    255255            WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo) 
    256             WRITE(numout,*) '             ending index' 
     256            WRITE(numout,*) '             ending index (mj1)' 
    257257            WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo) 
    258258         ENDIF 
  • branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/STO/stopar.F90

    r5571 r8970  
    159159      INTEGER  :: ji, jj, jk, jsto, jflt 
    160160      REAL(wp) :: stomax 
    161  
     161      !!---------------------------------------------------------------------- 
    162162      ! 
    163163      ! Update 2D stochastic arrays 
     
    235235         CALL lbc_lnk( sto3d(:,:,:,jsto), sto3d_typ(jsto), sto3d_sgn(jsto) ) 
    236236      END DO 
    237  
     237      ! 
    238238   END SUBROUTINE sto_par 
    239239 
     
    267267      REWIND( numnam_cfg )              ! Namelist namdyn_adv in configuration namelist : Momentum advection scheme 
    268268      READ  ( numnam_cfg, namsto, IOSTAT = ios, ERR = 902 ) 
    269 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsto in configuration namelist', lwp ) 
     269902   IF( ios > 0 ) CALL ctl_nam ( ios , 'namsto in configuration namelist', lwp ) 
    270270      IF(lwm) WRITE ( numond, namsto ) 
     271 
     272      IF( .NOT.ln_rststo ) THEN   ! no use of stochastic parameterization 
     273         IF(lwp) THEN 
     274            WRITE(numout,*) 
     275            WRITE(numout,*) 'sto_par_init : NO use of stochastic parameterization' 
     276            WRITE(numout,*) '~~~~~~~~~~~~' 
     277         ENDIF 
     278         RETURN 
     279      ENDIF 
    271280 
    272281      !IF(ln_ens_rst_in) cn_storst_in = cn_mem//cn_storst_in 
     
    673682      !!                  ***  ROUTINE sto_rst_read  *** 
    674683      !! 
    675  
    676684      !! ** Purpose :   read stochastic parameters from restart file 
    677685      !!---------------------------------------------------------------------- 
    678  
    679686      INTEGER  :: jsto, jseed 
    680687      INTEGER(KIND=8)     ::   ziseed(4)           ! RNG seeds in integer type 
     
    683690      CHARACTER(LEN=9)    ::   clsto3d='sto3d_000' ! stochastic parameter variable name 
    684691      CHARACTER(LEN=10)   ::   clseed='seed0_0000' ! seed variable name 
     692      !!---------------------------------------------------------------------- 
    685693 
    686694      IF ( jpsto2d > 0 .OR. jpsto3d > 0 ) THEN 
  • branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/TRA/trabbc.F90

    r8882 r8970  
    160160         ! 
    161161         CASE ( 1 )                          !* constant flux 
    162             IF(lwp) WRITE(numout,*) '      *** constant heat flux  =   ', rn_geoflx_cst 
     162            IF(lwp) WRITE(numout,*) '      ===>>  constant heat flux  =   ', rn_geoflx_cst 
    163163            qgh_trd0(:,:) = r1_rau0_rcp * rn_geoflx_cst 
    164164            ! 
    165165         CASE ( 2 )                          !* variable geothermal heat flux : read the geothermal fluxes in mW/m2 
    166             IF(lwp) WRITE(numout,*) '      *** variable geothermal heat flux' 
     166            IF(lwp) WRITE(numout,*) '      ===>>  variable geothermal heat flux' 
    167167            ! 
    168168            ALLOCATE( sf_qgh(1), STAT=ierror ) 
     
    172172            ENDIF 
    173173            ALLOCATE( sf_qgh(1)%fnow(jpi,jpj,1)   ) 
    174             IF( sn_qgh%ln_tint )ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) ) 
     174            IF( sn_qgh%ln_tint )   ALLOCATE( sf_qgh(1)%fdta(jpi,jpj,1,2) ) 
    175175            ! fill sf_chl with sn_chl and control print 
    176176            CALL fld_fill( sf_qgh, (/ sn_qgh /), cn_dir, 'tra_bbc_init',   & 
     
    186186         ! 
    187187      ELSE 
    188          IF(lwp) WRITE(numout,*) '      *** no geothermal heat flux' 
     188         IF(lwp) WRITE(numout,*) '      ===>>  no geothermal heat flux' 
    189189      ENDIF 
    190190      ! 
  • branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r8882 r8970  
    1919   USE dom_oce        ! ocean space and time domain 
    2020   USE domvvl         ! ocean space and time domain : variable volume layer 
    21    USE zdf_oce        ! ocean vertical physics 
    2221   USE zdfdrg  , ONLY : r_z0_top , r_z0_bot   ! top/bottom roughness 
    2322   USE zdfdrg  , ONLY : rCdU_top , rCdU_bot   ! top/bottom friction 
     
    133132      !!              coefficients using the GLS turbulent closure scheme. 
    134133      !!---------------------------------------------------------------------- 
     134      USE zdf_oce , ONLY : en, avtb, avmb   ! ocean vertical physics 
     135      !! 
    135136      INTEGER                   , INTENT(in   ) ::   kt             ! ocean time step 
    136137      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_sh2          ! shear production term 
     
    580581         zdep (:,:)   = ((zhsro(:,:) + gdept_n(:,:,1)) / zhsro(:,:))**(rmm*ra_sf) 
    581582         zflxs(:,:)   = (rnn + rsbc_tke1 * (rnn + rmm*ra_sf) * zdep(:,:))*(1._wp + rsbc_tke1*zdep(:,:))**(2._wp*rmm/3._wp-1_wp) 
    582          zdep (:,:)   = rsbc_psi1 * (zwall_psi(:,:,1)*avm(:,:,1)+zwall_psi(:,:,2)*avm(:,:,2)) * & 
     583         zdep (:,:)   = rsbc_psi1 * (zwall_psi(:,:,1)*p_avm(:,:,1)+zwall_psi(:,:,2)*p_avm(:,:,2)) * & 
    583584            &           ustar2_surf(:,:)**rmm * zkar(:,:)**rnn * (zhsro(:,:) + gdept_n(:,:,1))**(rnn-1.) 
    584585         zflxs(:,:)   = zdep(:,:) * zflxs(:,:) 
     
    815816         END DO 
    816817      END DO 
    817       avt(:,:,1) = 0._wp 
     818      p_avt(:,:,1) = 0._wp 
    818819      ! 
    819820      IF(ln_ctl) THEN 
    820          CALL prt_ctl( tab3d_1=en , clinfo1=' gls  - e: ', tab3d_2=avt, clinfo2=' t: ', ovlap=1, kdim=jpk) 
    821          CALL prt_ctl( tab3d_1=avm, clinfo1=' gls  - m: ', ovlap=1, kdim=jpk ) 
     821         CALL prt_ctl( tab3d_1=en   , clinfo1=' gls  - e: ', tab3d_2=p_avt, clinfo2=' t: ', ovlap=1, kdim=jpk) 
     822         CALL prt_ctl( tab3d_1=p_avm, clinfo1=' gls  - m: ', ovlap=1, kdim=jpk ) 
    822823      ENDIF 
    823824      ! 
     
    11441145      !!                set to rn_emin or recomputed (nn_igls/=0) 
    11451146      !!---------------------------------------------------------------------- 
     1147      USE zdf_oce , ONLY : en, avt_k, avm_k   ! ocean vertical physics 
     1148      !! 
    11461149      INTEGER         , INTENT(in) ::   kt     ! ocean time-step 
    11471150      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
  • branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r8882 r8970  
    4343   USE domvvl         ! domain: variable volume layer 
    4444   USE sbc_oce        ! surface boundary condition: ocean 
    45    USE zdf_oce        ! vertical physics: ocean variables 
    4645   USE zdfdrg         ! vertical physics: top/bottom drag coef. 
    4746   USE zdfmxl         ! vertical physics: mixed layer 
     
    185184      !! ** Action  : - en : now turbulent kinetic energy) 
    186185      !! --------------------------------------------------------------------- 
     186      USE zdf_oce , ONLY : en   ! ocean vertical physics 
     187      !! 
    187188      REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   pdepw          ! depth of w-points 
    188189      REAL(wp), DIMENSION(:,:,:) , INTENT(in   ) ::   p_e3t, p_e3w   ! level thickness (t- & w-points) 
     
    469470      !! ** Action  : - avt, avm : now vertical eddy diffusivity and viscosity (w-point) 
    470471      !!---------------------------------------------------------------------- 
     472      USE zdf_oce , ONLY : en, avtb, avmb, avtb_2d   ! ocean vertical physics 
     473      !! 
    471474      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   pdepw          ! depth (w-points) 
    472475      REAL(wp), DIMENSION(:,:,:), INTENT(in   ) ::   p_e3t, p_e3w   ! level thickness (t- & w-points) 
     
    618621      ! 
    619622      IF(ln_ctl) THEN 
    620          CALL prt_ctl( tab3d_1=en , clinfo1=' tke  - e: ', tab3d_2=avt, clinfo2=' t: ', ovlap=1, kdim=jpk) 
    621          CALL prt_ctl( tab3d_1=avm, clinfo1=' tke  - m: ', ovlap=1, kdim=jpk ) 
     623         CALL prt_ctl( tab3d_1=en   , clinfo1=' tke  - e: ', tab3d_2=p_avt, clinfo2=' t: ', ovlap=1, kdim=jpk) 
     624         CALL prt_ctl( tab3d_1=p_avm, clinfo1=' tke  - m: ', ovlap=1, kdim=jpk ) 
    622625      ENDIF 
    623626      ! 
     
    641644      !! ** Action  :   Increase by 1 the nstop flag is setting problem encounter 
    642645      !!---------------------------------------------------------------------- 
     646      USE zdf_oce , ONLY : ln_zdfiwm   ! Internal Wave Mixing flag 
     647      !! 
    643648      INTEGER ::   ji, jj, jk   ! dummy loop indices 
    644649      INTEGER ::   ios 
    645650      !! 
    646       NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin  ,   & 
    647          &                 rn_emin0, rn_bshear, nn_mxl , ln_mxl0  ,   & 
    648          &                 rn_mxl0 , nn_pdl   , ln_drg , ln_lc    , rn_lc    ,   & 
     651      NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb , rn_emin  ,          & 
     652         &                 rn_emin0, rn_bshear, nn_mxl , ln_mxl0  ,          & 
     653         &                 rn_mxl0 , nn_pdl   , ln_drg , ln_lc    , rn_lc,   & 
    649654         &                 nn_etau , nn_htau  , rn_efr    
    650655      !!---------------------------------------------------------------------- 
     
    711716      IF( nn_htau < 0   .OR.  nn_htau > 1 )   CALL ctl_stop( 'bad flag: nn_htau is 0, 1 or 2 ' ) 
    712717      IF( nn_etau == 3 .AND. .NOT. ln_cpl )   CALL ctl_stop( 'nn_etau == 3 : HF taum only known in coupled mode' ) 
    713  
     718      ! 
    714719      IF( ln_mxl0 ) THEN 
    715720         IF(lwp) WRITE(numout,*) '   use a surface mixing length = F(stress) :   set rn_mxl0 = rmxl_min' 
     
    728733         END SELECT 
    729734      ENDIF 
    730       !                               !* set vertical eddy coef. to the background value 
    731       DO jk = 1, jpk 
    732          avt(:,:,jk) = avtb(jk) * wmask(:,:,jk) 
    733          avm(:,:,jk) = avmb(jk) * wmask(:,:,jk) 
    734       END DO 
    735       dissl(:,:,:) = 1.e-12_wp 
    736       !                               
    737       CALL tke_rst( nit000, 'READ' )  !* read or initialize all required files 
     735      !                                !* read or initialize all required files 
     736      CALL tke_rst( nit000, 'READ' )      ! (en, avt_k, avm_k, dissl)  
    738737      ! 
    739738   END SUBROUTINE zdf_tke_init 
     
    750749      !!                set to rn_emin or recomputed  
    751750      !!---------------------------------------------------------------------- 
     751      USE zdf_oce , ONLY : en, avt_k, avm_k   ! ocean vertical physics 
     752      !! 
    752753      INTEGER         , INTENT(in) ::   kt     ! ocean time-step 
    753754      CHARACTER(len=*), INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
     
    772773            ELSE                                          ! start TKE from rest 
    773774               IF(lwp) WRITE(numout,*) '   ==>>   previous run without TKE scheme, set en to background values' 
    774                en(:,:,:) = rn_emin * wmask(:,:,:) 
     775               en   (:,:,:) = rn_emin * wmask(:,:,:) 
     776               dissl(:,:,:) = 1.e-12_wp 
    775777               ! avt_k, avm_k already set to the background value in zdf_phy_init 
    776778            ENDIF 
    777779         ELSE                                   !* Start from rest 
    778780            IF(lwp) WRITE(numout,*) '   ==>>   start from rest: set en to the background value' 
    779             en(:,:,:) = rn_emin * wmask(:,:,:) 
     781            en   (:,:,:) = rn_emin * wmask(:,:,:) 
     782            dissl(:,:,:) = 1.e-12_wp 
    780783            ! avt_k, avm_k already set to the background value in zdf_phy_init 
    781784         ENDIF 
  • branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r8885 r8970  
    458458 
    459459      !                                      ! Active tracers 
    460                            CALL tra_qsr_init      ! penetrative solar radiation qsr 
     460      IF( ln_traqsr    )   CALL tra_qsr_init      ! penetrative solar radiation qsr 
    461461                           CALL tra_bbc_init      ! bottom heat flux 
    462462      IF( ln_trabbl    )   CALL tra_bbl_init      ! advective (and/or diffusive) bottom boundary layer scheme 
Note: See TracChangeset for help on using the changeset viewer.