Changeset 2578


Ignore:
Timestamp:
2011-02-03T19:33:40+01:00 (11 years ago)
Author:
rblod
Message:

first import of NEMOTAM 3.2.2

Location:
branches/TAM_V3_2_2
Files:
103 added
13 edited

Legend:

Unmodified
Added
Removed
  • branches/TAM_V3_2_2/NEMO/OPA_SRC/DOM/daymod.F90

    r1730 r2578  
    3939   PUBLIC   day        ! called by step.F90 
    4040   PUBLIC   day_init   ! called by istate.F90 
    41  
    42    INTEGER ::   nsecd, nsecd05, ndt, ndt05 
     41   PUBLIC   day_mth    ! called by daymod_tam.F90 
     42 
     43   INTEGER, PUBLIC ::   nsecd, ndt, ndt05 
     44   INTEGER ::   nsecd05 
    4345 
    4446   !!---------------------------------------------------------------------- 
     
    239241      ENDIF 
    240242 
    241       IF( lrst_oce )   CALL day_rst( kt, 'WRITE' ) 
     243      CALL rst_opn( kt )                                ! Open the restart file if needed and control lrst_oce 
     244      IF( lrst_oce )   CALL day_rst( kt, 'WRITE' )      ! write day restart information 
    242245      ! 
    243246   END SUBROUTINE day 
  • branches/TAM_V3_2_2/NEMO/OPA_SRC/DYN/dynadv.F90

    r1601 r2578  
    2323 
    2424   PUBLIC dyn_adv     ! routine called by step module 
     25   PUBLIC dyn_adv_ctl ! routine called by dynadv_tam module 
    2526  
    2627   LOGICAL, PUBLIC ::   ln_dynadv_vec  = .TRUE.    ! vector form flag 
  • branches/TAM_V3_2_2/NEMO/OPA_SRC/DYN/dynhpg.F90

    r1601 r2578  
    5151   REAL(wp), PUBLIC ::   rn_gamma      = 0.e0      !: weighting coefficient 
    5252   LOGICAL , PUBLIC ::   ln_dynhpg_imp = .FALSE.   !: semi-implicite hpg flag 
    53    INTEGER , PUBLIC ::   nn_dynhpg_rst = 0         !: add dynhpg implicit variables in restart ot not 
    54  
    55    INTEGER  ::   nhpg  =  0   ! = 0 to 6, type of pressure gradient scheme used ! (deduced from ln_hpg_... flags) 
     53 
     54   INTEGER , PUBLIC ::   nhpg  =  0   ! = 0 to 6, type of pressure gradient scheme used ! (deduced from ln_hpg_... flags) 
    5655 
    5756   !! * Substitutions 
     
    124123!     NAMELIST/namdyn_hpg/ ln_hpg_zco   , ln_hpg_zps   , ln_hpg_sco, ln_hpg_hel,   & 
    125124!        &                 ln_hpg_wdj   , ln_hpg_djc   , ln_hpg_rot, rn_gamma  ,   & 
    126 !        &                 ln_dynhpg_imp, nn_dynhpg_rst 
     125!        &                 ln_dynhpg_imp 
    127126      !!---------------------------------------------------------------------- 
    128127 
     
    144143         WRITE(numout,*) '      weighting coeff. (wdj scheme)                     rn_gamma      = ', rn_gamma 
    145144         WRITE(numout,*) '      time stepping: centered (F) or semi-implicit (T)  ln_dynhpg_imp = ', ln_dynhpg_imp 
    146          WRITE(numout,*) '      add in restart dynhpg semi-implicit variable      nn_dynhpg_rst = ', nn_dynhpg_rst 
    147145      ENDIF 
    148  
    149       IF( .NOT. ln_dynhpg_imp )   nn_dynhpg_rst = 0      ! force no adding dynhpg implicit variables in restart 
    150146 
    151147      IF( lk_vvl .AND. .NOT. ln_hpg_sco )   THEN 
  • branches/TAM_V3_2_2/NEMO/OPA_SRC/DYN/sshwzv.F90

    r1756 r2578  
    2727   USE diaar5, ONLY :   lk_diaar5 
    2828   USE iom 
     29   USE agrif_opa_interp 
     30   USE agrif_opa_update 
    2931 
    3032   IMPLICIT NONE 
     
    137139 
    138140                         CALL div_cur( kt )            ! Horizontal divergence & Relative vorticity 
    139       IF( n_cla == 1 )   CALL div_cla( kt )            ! Cross Land Advection (Update Hor. divergence) 
     141         IF( n_cla == 1 )   CALL div_cla( kt )            ! Cross Land Advection (Update Hor. divergence) 
    140142 
    141143      ! set time step size (Euler/Leapfrog) 
     
    145147      zraur = 1. / rau0 
    146148 
    147       !                                           !------------------------------! 
    148       !                                           !   After Sea Surface Height   ! 
    149       !                                           !------------------------------! 
    150       zhdiv(:,:) = 0.e0 
    151       DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports 
    152         zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk) 
    153       END DO 
    154  
    155       !                                                ! Sea surface elevation time stepping 
    156       ssha(:,:) = (  sshb(:,:) - z2dt * ( zraur * emp(:,:) + zhdiv(:,:) )  ) * tmask(:,:,1) 
    157  
     149         !                                           !------------------------------! 
     150         !                                           !   After Sea Surface Height   ! 
     151         !                                           !------------------------------! 
     152         zhdiv(:,:) = 0.e0 
     153         DO jk = 1, jpkm1                                 ! Horizontal divergence of barotropic transports 
     154            zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk) 
     155         END DO 
     156 
     157         !                                                ! Sea surface elevation time stepping 
     158         ssha(:,:) = (  sshb(:,:) - z2dt * ( zraur * emp(:,:) + zhdiv(:,:) )  ) * tmask(:,:,1) 
     159 
     160# if defined key_agrif 
     161      CALL agrif_ssh(kt) 
     162# endif 
    158163#if defined key_obc 
    159 # if defined key_agrif 
    160164      IF ( Agrif_Root() ) THEN  
     165            ssha(:,:) = ssha(:,:) * obctmsk(:,:) 
     166            CALL lbc_lnk( ssha, 'T', 1. )  ! absolutly compulsory !! (jmm) 
     167         ENDIF 
    161168# endif 
    162          ssha(:,:) = ssha(:,:) * obctmsk(:,:) 
    163          CALL lbc_lnk( ssha, 'T', 1. )  ! absolutly compulsory !! (jmm) 
    164 # if defined key_agrif 
    165       ENDIF 
    166 # endif 
    167 #endif 
    168  
    169       !                                                ! Sea Surface Height at u-,v- and f-points (vvl case only) 
    170       IF( lk_vvl ) THEN                                ! (required only in key_vvl case) 
    171          DO jj = 1, jpjm1 
    172             DO ji = 1, jpim1      ! NO Vector Opt. 
    173                sshu_a(ji,jj) = 0.5  * umask(ji,jj,1) / ( e1u(ji  ,jj) * e2u(ji  ,jj) )                   & 
    174                   &                                  * ( e1t(ji  ,jj) * e2t(ji  ,jj) * ssha(ji  ,jj)     & 
    175                   &                                    + e1t(ji+1,jj) * e2t(ji+1,jj) * ssha(ji+1,jj) ) 
    176                sshv_a(ji,jj) = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj  ) * e2v(ji,jj  ) )                   & 
    177                   &                                  * ( e1t(ji,jj  ) * e2t(ji,jj  ) * ssha(ji,jj  )     & 
    178                   &                                    + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha(ji,jj+1) ) 
    179                sshf_a(ji,jj) = 0.25 * umask(ji,jj,1) * umask (ji,jj+1,1)                                 &  
    180                   &                                  * ( ssha(ji  ,jj) + ssha(ji  ,jj+1)                 & 
    181                   &                                    + ssha(ji+1,jj) + ssha(ji+1,jj+1) ) 
    182             END DO 
    183          END DO 
    184          CALL lbc_lnk( sshu_a, 'U', 1. )               ! Boundaries conditions 
    185          CALL lbc_lnk( sshv_a, 'V', 1. ) 
    186          CALL lbc_lnk( sshf_a, 'F', 1. ) 
    187       ENDIF 
     169 
     170         !                                                ! Sea Surface Height at u-,v- and f-points (vvl case only) 
     171         IF( lk_vvl ) THEN                                ! (required only in key_vvl case) 
     172            DO jj = 1, jpjm1 
     173               DO ji = 1, jpim1      ! NO Vector Opt. 
     174                  sshu_a(ji,jj) = 0.5  * umask(ji,jj,1) / ( e1u(ji  ,jj) * e2u(ji  ,jj) )                   & 
     175                       &                                  * ( e1t(ji  ,jj) * e2t(ji  ,jj) * ssha(ji  ,jj)     & 
     176                       &                                    + e1t(ji+1,jj) * e2t(ji+1,jj) * ssha(ji+1,jj) ) 
     177                  sshv_a(ji,jj) = 0.5  * vmask(ji,jj,1) / ( e1v(ji,jj  ) * e2v(ji,jj  ) )                   & 
     178                       &                                  * ( e1t(ji,jj  ) * e2t(ji,jj  ) * ssha(ji,jj  )     & 
     179                       &                                    + e1t(ji,jj+1) * e2t(ji,jj+1) * ssha(ji,jj+1) ) 
     180                  sshf_a(ji,jj) = 0.25 * umask(ji,jj,1) * umask (ji,jj+1,1)                                 &  
     181                       &                                  * ( ssha(ji  ,jj) + ssha(ji  ,jj+1)                 & 
     182                       &                                    + ssha(ji+1,jj) + ssha(ji+1,jj+1) ) 
     183               END DO 
     184            END DO 
     185            CALL lbc_lnk( sshu_a, 'U', 1. )               ! Boundaries conditions 
     186            CALL lbc_lnk( sshv_a, 'V', 1. ) 
     187            CALL lbc_lnk( sshf_a, 'F', 1. ) 
     188         ENDIF 
    188189 
    189190      !                                           !------------------------------! 
     
    197198      END DO 
    198199      ! 
    199       CALL iom_put( "woce", wn                    )   ! vertical velocity 
    200       CALL iom_put( "ssh" , sshn                  )   ! sea surface height 
    201       CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) )   ! square of sea surface height 
    202       IF( lk_diaar5 ) THEN 
    203          z2d(:,:) = rau0 * e1t(:,:) * e2t(:,:) 
    204          DO jk = 1, jpk 
    205             z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 
    206          END DO 
    207          CALL iom_put( "w_masstr" , z3d                     )   !           vertical mass transport 
    208          CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) )   ! square of vertical mass transport 
    209       ENDIF 
     200         CALL iom_put( "woce", wn                    )   ! vertical velocity 
     201         CALL iom_put( "ssh" , sshn                  )   ! sea surface height 
     202         CALL iom_put( "ssh2", sshn(:,:) * sshn(:,:) )   ! square of sea surface height 
     203         IF( lk_diaar5 ) THEN 
     204            z2d(:,:) = rau0 * e1t(:,:) * e2t(:,:) 
     205            DO jk = 1, jpk 
     206               z3d(:,:,jk) = wn(:,:,jk) * z2d(:,:) 
     207            END DO 
     208            CALL iom_put( "w_masstr" , z3d                     )   !           vertical mass transport 
     209            CALL iom_put( "w_masstr2", z3d(:,:,:) * z3d(:,:,:) )   ! square of vertical mass transport 
     210         ENDIF 
    210211      ! 
    211212   END SUBROUTINE ssh_wzv 
     
    279280      ENDIF 
    280281      ! 
     282#if defined key_agrif 
     283      ! Update velocity at AGRIF zoom boundaries 
     284      IF (.NOT.Agrif_Root())    CALL Agrif_Update_Dyn( kt ) 
     285#endif 
     286 
    281287      IF(ln_ctl)   CALL prt_ctl(tab2d_1=sshb    , clinfo1=' sshb  - : ', mask1=tmask, ovlap=1 ) 
    282288      ! 
  • branches/TAM_V3_2_2/NEMO/OPA_SRC/TRA/eosbn2.F90

    r1613 r2578  
    1616   !!             -   ! 2003-08  (G. Madec)  F90, free form 
    1717   !!            3.0  ! 2006-08  (G. Madec)  add tfreez function 
     18   !!                 ! 2009-03  (M. Balmaseda) compute refrence rho prof 
    1819   !!---------------------------------------------------------------------- 
    1920 
     
    2425   !!                    volumic mass 
    2526   !!   eos_insitu_2d  : Compute the in situ density for 2d fields 
     27   !!   eos_insitu_pot_1pt : Compute the in situ density for a single point 
    2628   !!   eos_bn2        : Compute the Brunt-Vaisala frequency 
    2729   !!   tfreez         : Compute the surface freezing temperature 
    2830   !!   eos_init       : set eos parameters (namelist) 
     31   !!   eos_rprof      : Compute the in situ density of a reference profile 
    2932   !!---------------------------------------------------------------------- 
    3033   USE dom_oce         ! ocean space and time domain 
     
    5659 
    5760   REAL(wp), PUBLIC ::   ralpbet           !: alpha / beta ratio 
     61   INTEGER, PUBLIC  ::   neos_init = 0     !: control flag for initialization 
    5862    
    5963   !! * Substitutions 
     
    592596      !!---------------------------------------------------------------------- 
    593597      ! 
     598      neos_init = 1               ! indicate that the initialization has been done 
     599 
    594600      REWIND( numnam )            ! Read Namelist nameos : equation of state 
    595601      READ  ( numnam, nameos ) 
  • branches/TAM_V3_2_2/NEMO/OPA_SRC/TRA/tradmp.F90

    r1601 r2578  
    4141 
    4242   PUBLIC   tra_dmp    ! routine called by step.F90 
     43   PUBLIC cofdis, dtacof, dtacof_zoom 
    4344 
    4445#if ! defined key_agrif 
     
    315316      resto(:,:,:) = 0.e0 
    316317 
    317       !                           !-----------------------------------------! 
     318         !                        !-----------------------------------------! 
    318319      IF( nn_hdmp > 0 ) THEN      !  Damping poleward of 'nn_hdmp' degrees  ! 
    319320         !                        !-----------------------------------------! 
  • branches/TAM_V3_2_2/NEMO/OPA_SRC/TRA/tranxt.F90

    r1601 r2578  
    3838   USE agrif_opa_update 
    3939   USE agrif_opa_interp 
     40   USE obc_oce 
    4041 
    4142   IMPLICIT NONE 
     
    4445   PUBLIC   tra_nxt    ! routine called by step.F90 
    4546 
    46    REAL(wp), DIMENSION(jpk) ::   r2dt_t   ! vertical profile time step, =2*rdttra (leapfrog) or =rdttra (Euler) 
     47   REAL(wp), PUBLIC, DIMENSION(jpk) ::   r2dt_t   ! vertical profile time step, =2*rdttra (leapfrog) or =rdttra (Euler) 
    4748 
    4849   !! * Substitutions 
     
    101102      ! 
    102103#if defined key_obc 
    103       CALL obc_tra( kt )              ! OBC open boundaries 
     104      IF( lk_obc )   CALL obc_tra( kt ) ! OBC open boundaries 
    104105#endif 
    105106#if defined key_bdy 
  • branches/TAM_V3_2_2/NEMO/OPA_SRC/TRA/traqsr.F90

    r1756 r2578  
    3232 
    3333   PUBLIC   tra_qsr        ! routine called by step.F90 (ln_traqsr=T) 
    34  
     34   PUBLIC   tra_qsr_init   ! routine called by traqsr_tam.F90 (ln_traqsr=T) 
    3535   !                                           !!* Namelist namtra_qsr: penetrative solar radiation 
    3636   LOGICAL , PUBLIC ::   ln_traqsr  = .TRUE.    !: light absorption (qsr) flag 
     
    4545    
    4646   ! Module variables 
    47    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read) 
    48    INTEGER ::  nksr   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
    49    REAL(wp), DIMENSION(3,61) ::   rkrgb   !: tabulated attenuation coefficients for RGB absorption 
     47   TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read) 
     48   INTEGER, PUBLIC :: nksr   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
     49   REAL(wp), PUBLIC, DIMENSION(3,61) ::   rkrgb   !: tabulated attenuation coefficients for RGB absorption 
    5050 
    5151   !! * Substitutions 
  • branches/TAM_V3_2_2/NEMO/OPA_SRC/ZDF/zdftke.F90

    r1756 r2578  
    8787 
    8888   REAL(wp), DIMENSION(jpi,jpj)     ::   htau      ! depth of tke penetration (nn_htau) 
    89    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   en        ! now turbulent kinetic energy   [m2/s2] 
     89   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::  en ! now turbulent kinetic energy   [m2/s2] 
    9090   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   dissl     ! now mixing lenght of dissipation 
    9191 
  • branches/TAM_V3_2_2/NEMO/OPA_SRC/ZDF/zdftke_old.F90

    r1617 r2578  
    3131   !!   zdf_tke_old  : update momentum and tracer Kz from a tke scheme 
    3232   !!   zdf_tke_init : initialization, namelist read, and parameters control 
    33    !!   tke_rst      : read/write tke restart in ocean restart file 
     33   !!   tke_old_rst  : read/write tke restart in ocean restart file 
    3434   !!---------------------------------------------------------------------- 
    3535   USE oce             ! ocean dynamics and active tracers  
     
    4949 
    5050   PUBLIC   zdf_tke_old   ! routine called in step module 
     51   PUBLIC   tke_old_rst       ! routine called in asm module 
    5152 
    5253   LOGICAL , PUBLIC, PARAMETER              ::   lk_zdftke_old = .TRUE.  !: TKE vertical mixing flag 
     
    6667 
    6768   !                                       !!! ** Namelist  namzdf_tke  ** 
    68    LOGICAL  ::   ln_rstke = .FALSE.         ! =T restart with tke from a run without tke 
    6969   LOGICAL  ::   ln_mxl0  = .FALSE.         ! mixing length scale surface value as function of wind stress or not 
    7070   LOGICAL  ::   ln_lc    = .FALSE.         ! Langmuir cells (LC) as a source term of TKE or not 
    71    INTEGER  ::   nn_itke  = 50              ! number of restart iterative loops 
    7271   INTEGER  ::   nn_mxl   =  2              ! type of mixing length (=0/1/2/3) 
    7372   INTEGER  ::   nn_pdl   =  1              ! Prandtl number or not (ratio avt/avm) (=0/1) 
    74    INTEGER  ::   nn_ave   =  1              ! horizontal average or not on avt, avmu, avmv (=0/1) 
    7573   REAL(wp) ::   rn_ediff = 0.1_wp          ! coefficient for avt: avt=rn_ediff*mxl*sqrt(e) 
    7674   REAL(wp) ::   rn_ediss = 0.7_wp          ! coefficient of the Kolmogoroff dissipation  
    7775   REAL(wp) ::   rn_ebb   = 3.75_wp         ! coefficient of the surface input of tke 
    78    REAL(wp) ::   rn_efave = 1._wp           ! coefficient for ave : ave=rn_efave*avm 
    7976   REAL(wp) ::   rn_emin  = 0.7071e-6_wp    ! minimum value of tke (m2/s2) 
    8077   REAL(wp) ::   rn_emin0 = 1.e-4_wp        ! surface minimum value of tke (m2/s2) 
    81    REAL(wp) ::   rn_cri   = 2._wp / 9._wp   ! critic Richardson number 
     78   REAL(wp) ::   rn_bshear= 1.e-20_wp       ! background shear (>0)    (Not used in old TKE) 
    8279   INTEGER  ::   nn_etau  = 0               ! type of depth penetration of surface tke (=0/1/2) 
    8380   INTEGER  ::   nn_htau  = 0               ! type of tke profile of penetration (=0/1) 
     
    8582   REAL(wp) ::   rn_lmin  = 0.1_wp          ! interior min value of mixing length 
    8683   REAL(wp) ::   rn_efr   = 1.0_wp          ! fraction of TKE surface value which penetrates in the ocean 
     84   REAL(wp) ::   rn_addhft= 0.0_wp          ! add offset   applied to HF tau    (Not used in old TKE) 
     85   REAL(wp) ::   rn_sclhft= 1.0_wp          ! scale factor applied to HF tau    (Not used in old TKE) 
    8786   REAL(wp) ::   rn_lc    = 0.15_wp         ! coef to compute vertical velocity of Langmuir cells 
     87 
     88  !                                       !! ** old namelist value: now hard coded ** 
     89   INTEGER  ::   nn_ave   =  1              ! horizontal average or not on avt, avmu, avmv (=0/1) 
     90   REAL(wp) ::   rn_efave = 1._wp           ! coefficient for ave : ave=rn_efave*avm 
     91   REAL(wp) ::   rn_cri   = 2._wp / 9._wp   ! critic Richardson number 
    8892 
    8993   !! * Substitutions 
     
    686690      CALL lbc_lnk( avt, 'W', 1. )                      ! Lateral boundary conditions on avt  (sign unchanged) 
    687691 
    688       IF( lrst_oce )   CALL tke_rst( kt, 'WRITE' )      ! write en in restart file 
     692      IF( lrst_oce )   CALL tke_old_rst( kt, 'WRITE' )      ! write en in restart file 
    689693 
    690694      IF(ln_ctl) THEN 
     
    721725# endif 
    722726      !! 
    723       NAMELIST/namzdf_tke/ ln_rstke, rn_ediff, rn_ediss, rn_ebb  , rn_efave, rn_emin,   & 
    724          &                 rn_emin0, rn_cri  , nn_itke , nn_mxl  , nn_pdl  , nn_ave ,   & 
    725          &                 ln_mxl0 , rn_lmin , rn_lmin0, nn_etau,   & 
    726          &                 nn_htau , rn_efr  , ln_lc   , rn_lc  
     727      NAMELIST/namzdf_tke/ rn_ediff, rn_ediss , rn_ebb   , rn_emin  ,   & 
     728         &                 rn_emin0, rn_bshear, nn_mxl   , ln_mxl0  ,   & 
     729         &                 rn_lmin , rn_lmin0 , nn_pdl   , nn_etau  ,   & 
     730         &                 nn_htau , rn_efr   , rn_addhft, rn_sclhft,   & 
     731         &                 ln_lc   , rn_lc  
    727732      !!---------------------------------------------------------------------- 
    728733 
     
    747752         WRITE(numout,*) '~~~~~~~~~~~~' 
    748753         WRITE(numout,*) '          Namelist namzdf_tke : set tke mixing parameters' 
    749          WRITE(numout,*) '             restart with tke from no tke              ln_rstke = ', ln_rstke 
    750754         WRITE(numout,*) '             coef. to compute avt                      rn_ediff = ', rn_ediff 
    751755         WRITE(numout,*) '             Kolmogoroff dissipation coef.             rn_ediss = ', rn_ediss 
    752756         WRITE(numout,*) '             tke surface input coef.                   rn_ebb   = ', rn_ebb 
    753          WRITE(numout,*) '             tke diffusion coef.                       rn_efave = ', rn_efave 
    754757         WRITE(numout,*) '             minimum value of tke                      rn_emin  = ', rn_emin 
    755758         WRITE(numout,*) '             surface minimum value of tke              rn_emin0 = ', rn_emin0 
    756          WRITE(numout,*) '             number of restart iter loops              nn_itke  = ', nn_itke 
    757759         WRITE(numout,*) '             mixing length type                        nn_mxl   = ', nn_mxl 
    758760         WRITE(numout,*) '             prandl number flag                        nn_pdl   = ', nn_pdl 
     
    852854      ! read or initialize turbulent kinetic energy ( en ) 
    853855      ! ------------------------------------------------- 
    854       CALL tke_rst( nit000, 'READ' ) 
     856      CALL tke_old_rst( nit000, 'READ' ) 
    855857      ! 
    856858   END SUBROUTINE zdf_tke_init 
    857859 
    858860 
    859    SUBROUTINE tke_rst( kt, cdrw ) 
     861   SUBROUTINE tke_old_rst( kt, cdrw ) 
    860862     !!--------------------------------------------------------------------- 
    861863     !!                   ***  ROUTINE ts_rst  *** 
     
    875877     IF( TRIM(cdrw) == 'READ' ) THEN 
    876878        IF( ln_rstart ) THEN 
    877            IF( iom_varid( numror, 'en', ldstop = .FALSE. ) > 0 .AND. .NOT.(ln_rstke) ) THEN  
     879           IF( iom_varid( numror, 'en', ldstop = .FALSE. ) > 0 ) THEN  
    878880              CALL iom_get( numror, jpdom_autoglo, 'en', en ) 
    879881           ELSE 
    880               IF( lwp .AND. iom_varid( numror, 'en', ldstop = .FALSE. ) > 0 )   & 
    881                  &                       WRITE(numout,*) ' ===>>>> : previous run without tke scheme' 
    882               IF( lwp .AND. ln_rstke )   WRITE(numout,*) ' ===>>>> : We do not use en from the restart file' 
     882              IF(lwp)  WRITE(numout,*) ' ===>>>> : previous run without tke scheme' 
    883883              IF( lwp                )   WRITE(numout,*) ' ===>>>> : en is set by iterative loop' 
    884884              en (:,:,:) = rn_emin * tmask(:,:,:) 
    885               DO jit = 2, nn_itke + 1 
     885              DO jit = 2, 51 
    886886                 CALL zdf_tke_old( jit ) 
    887887              END DO 
     
    894894     ENDIF 
    895895     ! 
    896    END SUBROUTINE tke_rst 
     896   END SUBROUTINE tke_old_rst 
    897897 
    898898#else 
  • branches/TAM_V3_2_2/NEMO/OPA_SRC/lib_mpp.F90

    r1718 r2578  
    112112   INTEGER ::   mppsize        ! number of process 
    113113   INTEGER ::   mpprank        ! process number  [ 0 - size-1 ] 
    114    INTEGER ::   mpi_comm_opa   ! opa local communicator 
     114!$AGRIF_DO_NOT_TREAT 
     115   INTEGER, PUBLIC ::   mpi_comm_opa   ! opa local communicator 
     116!$AGRIF_END_DO_NOT_TREAT 
    115117 
    116118   ! variables used in case of sea-ice 
     
    129131    
    130132   ! North fold condition in mpp_mpi with jpni > 1 
    131    INTEGER ::   ngrp_world        ! group ID for the world processors 
    132    INTEGER ::   ngrp_opa          ! group ID for the opa processors 
    133    INTEGER ::   ngrp_north        ! group ID for the northern processors (to be fold) 
    134    INTEGER ::   ncomm_north       ! communicator made by the processors belonging to ngrp_north 
    135    INTEGER ::   ndim_rank_north   ! number of 'sea' processor in the northern line (can be /= jpni !) 
    136    INTEGER ::   njmppmax          ! value of njmpp for the processors of the northern line 
    137    INTEGER ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm 
    138    INTEGER, DIMENSION(:), ALLOCATABLE ::   nrank_north   ! dimension ndim_rank_north 
     133   INTEGER, PUBLIC ::   ngrp_world        ! group ID for the world processors 
     134   INTEGER, PUBLIC ::   ngrp_opa          ! group ID for the opa processors 
     135   INTEGER, PUBLIC ::   ngrp_north        ! group ID for the northern processors (to be fold) 
     136   INTEGER, PUBLIC ::   ncomm_north       ! communicator made by the processors belonging to ngrp_north 
     137   INTEGER, PUBLIC ::   ndim_rank_north   ! number of 'sea' processor in the northern line (can be /= jpni !) 
     138   INTEGER, PUBLIC ::   njmppmax          ! value of njmpp for the processors of the northern line 
     139   INTEGER, PUBLIC ::   north_root        ! number (in the comm_opa) of proc 0 in the northern comm 
     140   INTEGER, PUBLIC, DIMENSION(:), ALLOCATABLE ::   nrank_north   ! dimension ndim_rank_north 
    139141 
    140142   ! Type of send : standard, buffered, immediate 
    141143   CHARACTER(len=1) ::   cn_mpi_send = 'S'    ! type od mpi send/recieve (S=standard, B=bsend, I=isend) 
    142    LOGICAL          ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I') 
     144   LOGICAL, PUBLIC  ::   l_isend = .FALSE.   ! isend use indicator (T if cn_mpi_send='I') 
    143145   INTEGER          ::   nn_buffer = 0       ! size of the buffer in case of mpi_bsend  
    144146       
     
    191193      WRITE(ldtxt(6),*) '      size in bytes of exported buffer   nn_buffer   = ', nn_buffer 
    192194 
    193 #if defined key_agrif 
    194       IF( Agrif_Root() ) THEN 
    195 #endif 
    196          !!bug RB : should be clean to use Agrif in coupled mode 
    197 #if ! defined key_agrif 
    198          CALL mpi_initialized ( mpi_was_called, code ) 
    199          IF( code /= MPI_SUCCESS ) THEN 
    200             WRITE(*, cform_err) 
    201             WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 
    202             CALL mpi_abort( mpi_comm_world, code, ierr ) 
    203          ENDIF 
    204  
    205          IF( PRESENT(localComm) .and. mpi_was_called ) THEN 
    206             mpi_comm_opa = localComm 
    207             SELECT CASE ( cn_mpi_send ) 
    208             CASE ( 'S' )                ! Standard mpi send (blocking) 
    209                WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
    210             CASE ( 'B' )                ! Buffer mpi send (blocking) 
    211                WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
    212                CALL mpi_init_opa( ierr )  
    213             CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    214                WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
    215                l_isend = .TRUE. 
    216             CASE DEFAULT 
    217                WRITE(ldtxt(7),cform_err) 
    218                WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
    219                nstop = nstop + 1 
    220             END SELECT 
    221          ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 
    222             WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 
    223             WRITE(ldtxt(8),*) '          without calling MPI_Init before ! ' 
    224             nstop = nstop + 1 
    225          ELSE 
    226 #endif 
    227             SELECT CASE ( cn_mpi_send ) 
    228             CASE ( 'S' )                ! Standard mpi send (blocking) 
    229                WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
    230                CALL mpi_init( ierr ) 
    231             CASE ( 'B' )                ! Buffer mpi send (blocking) 
    232                WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
    233                CALL mpi_init_opa( ierr ) 
    234             CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    235                WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
    236                l_isend = .TRUE. 
    237                CALL mpi_init( ierr ) 
    238             CASE DEFAULT 
    239                WRITE(ldtxt(7),cform_err) 
    240                WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
    241                nstop = nstop + 1 
    242             END SELECT 
    243  
    244 #if ! defined key_agrif 
    245             CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 
    246             IF( code /= MPI_SUCCESS ) THEN 
    247                WRITE(*, cform_err) 
    248                WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 
    249                CALL mpi_abort( mpi_comm_world, code, ierr ) 
    250             ENDIF 
    251             ! 
    252          ENDIF 
    253 #endif 
    254 #if defined key_agrif 
    255       ELSE 
     195      CALL mpi_initialized ( mpi_was_called, code ) 
     196      IF( code /= MPI_SUCCESS ) THEN 
     197         WRITE(*, cform_err) 
     198         WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 
     199         CALL mpi_abort( mpi_comm_world, code, ierr ) 
     200      ENDIF 
     201 
     202      IF( PRESENT(localComm) .and. mpi_was_called ) THEN 
     203         ! 
    256204         SELECT CASE ( cn_mpi_send ) 
    257205         CASE ( 'S' )                ! Standard mpi send (blocking) 
     
    259207         CASE ( 'B' )                ! Buffer mpi send (blocking) 
    260208            WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
     209            CALL mpi_init_opa( ierr )  
    261210         CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    262211            WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
     
    267216            nstop = nstop + 1 
    268217         END SELECT 
     218      ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 
     219         WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 
     220         WRITE(ldtxt(8),*) '          without calling MPI_Init before ! ' 
     221         nstop = nstop + 1 
     222      ELSE 
     223         SELECT CASE ( cn_mpi_send ) 
     224         CASE ( 'S' )                ! Standard mpi send (blocking) 
     225            WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
     226            CALL mpi_init( ierr ) 
     227         CASE ( 'B' )                ! Buffer mpi send (blocking) 
     228            WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
     229            CALL mpi_init_opa( ierr ) 
     230         CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
     231            WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
     232            l_isend = .TRUE. 
     233            CALL mpi_init( ierr ) 
     234         CASE DEFAULT 
     235            WRITE(ldtxt(7),cform_err) 
     236            WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
     237            nstop = nstop + 1 
     238         END SELECT 
     239         ! 
    269240      ENDIF 
    270241 
    271       mpi_comm_opa = mpi_comm_world 
    272 #endif 
     242      IF( PRESENT(localComm) ) THEN  
     243         IF( Agrif_Root() ) THEN 
     244            mpi_comm_opa = localComm 
     245         ENDIF 
     246      ELSE 
     247         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 
     248         IF( code /= MPI_SUCCESS ) THEN 
     249            WRITE(*, cform_err) 
     250            WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 
     251            CALL mpi_abort( mpi_comm_world, code, ierr ) 
     252         ENDIF 
     253      ENDIF  
     254 
    273255      CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr ) 
    274256      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr ) 
     
    926908         SELECT CASE ( jpni ) 
    927909         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jpr2dj), cd_type, psgn, pr2dj=jpr2dj ) 
    928          CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                    , cd_type, psgn               ) 
     910        CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                    , cd_type, psgn               ) 
    929911         END SELECT  
    930912         ! 
     
    20672049      ijpj   = 4 
    20682050      ijpjm1 = 3 
     2051      ztab(:,:,:) = 0.e0 
    20692052      ! 
    20702053      DO jj = nlcj - ijpj +1, nlcj          ! put in znorthloc the last 4 jlines of pt3d 
     
    21322115      ijpj   = 4 
    21332116      ijpjm1 = 3 
     2117      ztab(:,:) = 0.e0 
    21342118      ! 
    21352119      DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d 
     
    21972181      ! 
    21982182      ijpj=4 
     2183      ztab(:,:) = 0.e0 
    21992184 
    22002185      ij=0 
  • branches/TAM_V3_2_2/NEMO/OPA_SRC/opa.F90

    r1725 r2578  
    5454   USE trdmod          ! momentum/tracers trends       (trd_mod_init routine) 
    5555   USE diaptr          ! poleward transports           (dia_ptr_init routine) 
     56   USE tamtrj          ! writing out state trajectory 
     57 
    5658   USE step            ! OPA time-stepping                  (stp     routine) 
    5759#if defined key_oasis3 
     
    156158      CALL opa_closefile 
    157159#if defined key_oasis3 || defined key_oasis4 
    158       CALL cpl_prism_finalize           ! end coupling and mpp communications with OASIS 
     160      IF( Agrif_Root() ) THEN 
     161         CALL cpl_prism_finalize        ! end coupling and mpp communications with OASIS 
     162     ENDIF 
    159163#else 
    160164      IF( lk_mpp )   CALL mppstop       ! end mpp communications 
     
    190194      !                             !--------------------------------------------! 
    191195#if defined key_iomput 
     196      IF( Agrif_Root() ) THEN 
    192197# if defined key_oasis3 || defined key_oasis4 
    193       CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
    194       CALL init_ioclient()                    ! io_server will get its communicators (if needed) from oasis (we don't see it) 
    195 # else 
    196       CALL init_ioclient( ilocal_comm )       ! nemo local communicator (used or not) given by the io_server 
     198         CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
    197199# endif 
     200         CALL  init_ioclient( ilocal_comm )      ! exchange io_server nemo local communicator with the io_server 
     201      ENDIF 
    198202      narea = mynode( cltxt, ilocal_comm )    ! Nodes selection 
    199  
    200203#else 
    201204# if defined key_oasis3 || defined key_oasis4 
    202       CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
     205      IF( Agrif_Root() ) THEN 
     206         CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
     207      ENDIF 
    203208      narea = mynode( cltxt, ilocal_comm )    ! Nodes selection (control print return in cltxt) 
    204209# else 
     
    272277      CALL trd_mod_init                         ! Mixed-layer/Vorticity/Integral constraints trends 
    273278      ! 
     279      CALL tam_trj_init 
     280      ! 
    274281   END SUBROUTINE opa_init 
    275282 
     
    287294      NAMELIST/namdyn_hpg/ ln_hpg_zco   , ln_hpg_zps   , ln_hpg_sco, ln_hpg_hel,   & 
    288295         &                 ln_hpg_wdj   , ln_hpg_djc   , ln_hpg_rot, rn_gamma  ,   & 
    289          &                 ln_dynhpg_imp, nn_dynhpg_rst 
     296         &                 ln_dynhpg_imp 
    290297      !!---------------------------------------------------------------------- 
    291298 
  • branches/TAM_V3_2_2/NEMO/OPA_SRC/step.F90

    r1756 r2578  
    1919   !!             -   !  2006-01  (L. Debreu, C. Mazauric)  Agrif implementation 
    2020   !!             -   !  2006-07  (S. Masson)  restart using iom 
     21   !!             -   !  2008-06  (A. Vidard) TAM interface 
    2122   !!            3.2  !  2009-02  (G. Madec, R. Benshila)  reintroduicing z*-coordinate 
    2223   !!             -   !  2009-06  (S. Masson, G. Madec)  TKE restart compatible with key_cpl 
     
    112113   USE flo_oce         ! floats variables 
    113114   USE floats          ! floats computation               (flo_stp routine) 
     115   USE tamtrj          ! writing out state trajectory     
    114116 
    115117   USE stpctl          ! time stepping control            (stp_ctl routine) 
     
    160162      !!              -8- Outputs and diagnostics 
    161163      !!---------------------------------------------------------------------- 
     164      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zta_tmp, zsa_tmp 
    162165      INTEGER ::   jk       ! dummy loop indice 
    163166      INTEGER ::   indic    ! error indicator if < 0 
     
    168171!      IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 
    169172!      IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 
     173# if defined key_iomput 
     174      IF( Agrif_Nbstepint() == 0) CALL iom_swap 
     175# endif 
    170176#endif    
    171177      indic = 1                                       ! reset to no error condition 
     
    175181      CALL iom_setkt( kstp )                          ! say to iom that we are at time step kstp 
    176182       
    177       CALL rst_opn( kstp )                            ! Open the restart file 
    178  
    179183      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    180184      ! Update data, open boundaries, surface boundary condition (including sea-ice) 
     
    261265                             ta(:,:,:) = 0.e0               ! set tracer trends to zero 
    262266                             sa(:,:,:) = 0.e0 
     267 
     268      ! Saving non-linear trajectory at restart state 
     269      ! May not be exact for sbc and zdf parameters 
     270      IF( ( ln_trjwri ) .AND. ( kstp == nit000 ) ) CALL tam_trj_wri( kstp - 1 ) 
    263271 
    264272                             CALL tra_sbc    ( kstp )       ! surface boundary condition 
     
    292300         IF( ln_zdfnpc   )   CALL tra_npc    ( kstp )       ! update after fields by non-penetrative convection 
    293301                             CALL tra_nxt    ( kstp )       ! tracer fields at next time step 
    294       ENDIF  
     302     ENDIF  
     303 
     304      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     305      ! saving ta and sa (temporary fix, please do not remove) 
     306      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     307      IF (ln_trjwri) THEN 
     308                               ALLOCATE ( zta_tmp(jpi,jpj,jpk), & 
     309            &                             zsa_tmp(jpi,jpj,jpk)  ) 
     310                               zta_tmp(:,:,:) = ta(:,:,:) 
     311                               zsa_tmp(:,:,:) = sa(:,:,:) 
     312      END IF 
    295313 
    296314      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     
    335353         IF( lk_trdmld     )   CALL trd_mld( kstp )         ! trends: Mixed-layer  
    336354         IF( lk_trdvor     )   CALL trd_vor( kstp )         ! trends: vorticity budget 
    337       ENDIF 
     355      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     356      ! restoring ta and sa (temporary fix, please do not remove) 
     357      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
     358         IF (ln_trjwri) THEN 
     359            ta(:,:,:) = zta_tmp(:,:,:) 
     360            sa(:,:,:) = zsa_tmp(:,:,:) 
     361            DEALLOCATE ( zta_tmp, & 
     362               &         zsa_tmp  ) 
     363         END IF 
     364 
     365   
     366      ENDIF 
     367       
     368      IF( ln_trjwri ) CALL tam_trj_wri( kstp )          ! Output trajectory fields 
    338369 
    339370      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
Note: See TracChangeset for help on using the changeset viewer.