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 2053 for branches – NEMO

Changeset 2053 for branches


Ignore:
Timestamp:
2010-08-13T11:32:52+02:00 (14 years ago)
Author:
cetlod
Message:

improve the offline part to take into account the merge of TRA-TRC, see ticket:702

Location:
branches/DEV_r2006_merge_TRA_TRC/NEMO/OFF_SRC
Files:
4 added
33 deleted
3 edited

Legend:

Unmodified
Added
Removed

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OFF_SRC/dtadyn.F90

    r1735 r2053  
    1616   USE phycst          ! physical constants 
    1717   USE sbc_oce 
     18   USE trabbl 
    1819   USE ldfslp 
    19    USE ldfeiv          ! eddy induced velocity coef.      (ldf_eiv routine) 
     20   USE ldfeiv          ! eddy induced velocity coef.  
    2021   USE ldftra_oce      ! ocean tracer   lateral physics 
    2122   USE zdfmxl 
    22    USE trabbl 
    2323   USE eosbn2 
    2424   USE zdfddm          ! vertical  physics: double diffusion 
    … …  
    4141      ndtadyn = 73 ,  & ! Number of dat in one year 
    4242      ndtatot = 73 ,  & ! Number of data in the input field 
    43       nsptint = 1 ,   & ! type of spatial interpolation 
    44       nficdyn = 2       ! number of dynamical fields  
     43      nsptint = 1       ! type of spatial interpolation 
    4544 
    4645   CHARACTER(len=45)  ::  & 
    … …  
    6665      vdta   ,   & ! meridional velocity at two consecutive times 
    6766      wdta   ,   & ! vertical velocity at two consecutive times 
    68 #if defined key_trc_diatrd 
    69       hdivdta,   & ! horizontal divergence 
    70 #endif 
    7167      avtdta       ! vertical diffusivity coefficient 
    7268 
    … …  
    8682#endif 
    8783 
    88 #if ! defined key_off_degrad &&  defined key_traldf_c2d 
    89    REAL(wp), DIMENSION(jpi,jpj,2) ::   & 
    90       ahtwdta      ! Lateral diffusivity 
    91 # if defined key_trcldf_eiv  
     84#if ! defined key_degrad &&  defined key_traldf_c2d && defined key_traldf_eiv  
    9285   REAL(wp), DIMENSION(jpi,jpj,2) ::   & 
    9386      aeiwdta      ! G&M coefficient 
    94 # endif 
    95 #endif 
    96  
    97 #if defined key_off_degrad 
     87#endif 
     88 
     89#if defined key_degrad 
    9890   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
    9991      ahtudta, ahtvdta, ahtwdta  !  Lateral diffusivity 
    100 # if defined key_trcldf_eiv 
     92# if defined key_traldf_eiv 
    10193   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
    10294      aeiudta, aeivdta, aeiwdta  ! G&M coefficient 
    10395# endif 
    10496 
    105 #endif 
    106  
    107 #if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    108    REAL(wp), DIMENSION(jpi,jpj,2) ::       & 
    109       bblxdta ,  & ! frequency of bbl in the x direction at 2 consecutive times 
    110       bblydta      ! frequency of bbl in the y direction at 2 consecutive times 
    11197#endif 
    11298 
    … …  
    147133      INTEGER ::   iper, iperm1, iswap, izt    
    148134 
    149       REAL(wp) :: zpdtan, zpdtpe, zdemi, zt 
     135      REAL(wp) :: zt 
    150136      REAL(wp) :: zweigh 
    151  
    152       ! 0. Initialization 
    153       ! ----------------- 
    154  
    155       IF( lfirdyn ) THEN 
    156          ! first time step MUST BE nit000 
    157          IF( kt /= nit000 ) THEN 
    158             IF (lwp) THEN  
    159                WRITE (numout,*) ' kt MUST BE EQUAL to nit000. kt = ',kt ,' nit000 = ',nit000  
    160               STOP 'dtadyn' 
    161             ENDIF 
    162           ENDIF  
    163           ! Initialize the parameters of the interpolation 
    164           CALL dta_dyn_init 
    165       ENDIF 
     137      !!---------------------------------------------------------------------- 
    166138 
    167139      zt       = ( FLOAT (kt) + rnspdta2 ) / rnspdta 
    … …  
    211183         ENDIF 
    212184          
    213 #if defined key_ldfslp 
    214          ! Computes slopes 
    215          ! Caution : here tn, sn and avt are used as workspace 
    216          tn (:,:,:) = tdta  (:,:,:,2) 
    217          sn (:,:,:) = sdta  (:,:,:,2) 
    218          avt(:,:,:) = avtdta(:,:,:,2) 
     185         IF( lk_ldfslp ) THEN 
     186            ! Computes slopes 
     187            ! Caution : here tn, sn and avt are used as workspace 
     188            tn (:,:,:) = tdta  (:,:,:,2) 
     189            sn (:,:,:) = sdta  (:,:,:,2) 
     190            avt(:,:,:) = avtdta(:,:,:,2) 
    219191          
    220          CALL eos( tn, sn, rhd, rhop )   ! Time-filtered in situ density  
    221          CALL bn2( tn, sn, rn2 )         ! before Brunt-Vaisala frequency 
    222          IF( ln_zps )   & 
    223             &   CALL zps_hde( kt, tn , sn , rhd,  &  ! Partial steps: before Horizontal DErivative 
    224             &                 gtu, gsu, gru,  &  ! of t, s, rd at the bottom ocean level 
    225             &                 gtv, gsv, grv ) 
    226          CALL zdf_mxl( kt )              ! mixed layer depth 
    227          CALL ldf_slp( kt, rhd, rn2 ) 
     192            CALL eos( tn, sn, rhd, rhop )   ! Time-filtered in situ density  
     193            CALL bn2( tn, sn, rn2 )         ! before Brunt-Vaisala frequency 
     194            IF( ln_zps )   & 
     195               &   CALL zps_hde( kt, tn , sn , rhd,  &  ! Partial steps: before Horizontal DErivative 
     196               &                 gtu, gsu, gru,  &  ! of t, s, rd at the bottom ocean level 
     197               &                 gtv, gsv, grv ) 
     198                   CALL zdf_mxl( kt )              ! mixed layer depth 
     199                   CALL ldf_slp( kt, rhd, rn2 ) 
    228200          
    229          uslpdta (:,:,:,2) = uslp (:,:,:) 
    230          vslpdta (:,:,:,2) = vslp (:,:,:) 
    231          wslpidta(:,:,:,2) = wslpi(:,:,:) 
    232          wslpjdta(:,:,:,2) = wslpj(:,:,:) 
    233 #endif 
     201            uslpdta (:,:,:,2) = uslp (:,:,:) 
     202            vslpdta (:,:,:,2) = vslp (:,:,:) 
     203            wslpidta(:,:,:,2) = wslpi(:,:,:) 
     204            wslpjdta(:,:,:,2) = wslpj(:,:,:) 
     205         END IF 
    234206          
    235207         ! swap from record 2 to 1 
    … …  
    240212         CALL dynrea( kt, iper )    ! data read for the iper period 
    241213          
    242 #if defined key_ldfslp 
    243          ! Computes slopes 
    244          ! Caution : here tn, sn and avt are used as workspace 
    245          tn (:,:,:) = tdta  (:,:,:,2) 
    246          sn (:,:,:) = sdta  (:,:,:,2) 
    247          avt(:,:,:) = avtdta(:,:,:,2) 
    248           
    249          CALL eos( tn, sn, rhd, rhop )   ! Time-filtered in situ density  
    250          CALL bn2( tn, sn, rn2 )         ! before Brunt-Vaisala frequency 
    251          IF( ln_zps )   & 
    252             &   CALL zps_hde( kt, tn , sn , rhd,  &  ! Partial steps: before Horizontal DErivative 
    253             &                 gtu, gsu, gru,  &  ! of t, s, rd at the bottom ocean level 
    254             &                 gtv, gsv, grv ) 
    255          CALL zdf_mxl( kt )              ! mixed layer depth 
    256          CALL ldf_slp( kt, rhd, rn2 ) 
    257           
    258          uslpdta (:,:,:,2) = uslp (:,:,:) 
    259          vslpdta (:,:,:,2) = vslp (:,:,:) 
    260          wslpidta(:,:,:,2) = wslpi(:,:,:) 
    261          wslpjdta(:,:,:,2) = wslpj(:,:,:) 
    262 #endif 
     214         IF( lk_ldfslp ) THEN 
     215            ! Computes slopes 
     216            ! Caution : here tn, sn and avt are used as workspace 
     217            tn (:,:,:) = tdta  (:,:,:,2) 
     218            sn (:,:,:) = sdta  (:,:,:,2) 
     219            avt(:,:,:) = avtdta(:,:,:,2) 
     220 
     221            CALL eos( tn, sn, rhd, rhop )   ! Time-filtered in situ density  
     222            CALL bn2( tn, sn, rn2 )         ! before Brunt-Vaisala frequency 
     223            IF( ln_zps )   & 
     224               &   CALL zps_hde( kt, tn , sn , rhd,  &  ! Partial steps: before Horizontal DErivative 
     225               &                 gtu, gsu, gru,  &  ! of t, s, rd at the bottom ocean level 
     226               &                 gtv, gsv, grv ) 
     227                   CALL zdf_mxl( kt )              ! mixed layer depth 
     228                   CALL ldf_slp( kt, rhd, rn2 ) 
     229 
     230            uslpdta (:,:,:,2) = uslp (:,:,:) 
     231            vslpdta (:,:,:,2) = vslp (:,:,:) 
     232            wslpidta(:,:,:,2) = wslpi(:,:,:) 
     233            wslpjdta(:,:,:,2) = wslpj(:,:,:) 
     234         END IF 
    263235         ! 
    264236         lfirdyn=.FALSE.    ! trace the first call 
    … …  
    288260         CALL dynrea( kt, iper )    ! data read for the iper period 
    289261 
    290 #if defined key_ldfslp 
    291          ! Computes slopes 
    292          ! Caution : here tn, sn and avt are used as workspace 
    293          tn (:,:,:) = tdta  (:,:,:,2) 
    294          sn (:,:,:) = sdta  (:,:,:,2) 
    295          avt(:,:,:) = avtdta(:,:,:,2) 
    296           
    297          CALL eos( tn, sn, rhd, rhop )   ! Time-filtered in situ density  
    298          CALL bn2( tn, sn, rn2 )         ! before Brunt-Vaisala frequency 
    299          IF( ln_zps )   & 
    300             &   CALL zps_hde( kt, tn , sn , rhd,  &  ! Partial steps: before Horizontal DErivative 
    301             &                 gtu, gsu, gru,  &  ! of t, s, rd at the bottom ocean level 
    302             &                 gtv, gsv, grv ) 
    303          CALL zdf_mxl( kt )              ! mixed layer depth 
    304          CALL ldf_slp( kt, rhd, rn2 ) 
    305           
    306          uslpdta (:,:,:,2) = uslp (:,:,:) 
    307          vslpdta (:,:,:,2) = vslp (:,:,:) 
    308          wslpidta(:,:,:,2) = wslpi(:,:,:) 
    309          wslpjdta(:,:,:,2) = wslpj(:,:,:) 
    310 #endif 
     262         IF( lk_ldfslp ) THEN 
     263            ! Computes slopes 
     264            ! Caution : here tn, sn and avt are used as workspace 
     265            tn (:,:,:) = tdta  (:,:,:,2) 
     266            sn (:,:,:) = sdta  (:,:,:,2) 
     267            avt(:,:,:) = avtdta(:,:,:,2) 
     268 
     269            CALL eos( tn, sn, rhd, rhop )   ! Time-filtered in situ density  
     270            CALL bn2( tn, sn, rn2 )         ! before Brunt-Vaisala frequency 
     271            IF( ln_zps )   & 
     272               &   CALL zps_hde( kt, tn , sn , rhd,  &  ! Partial steps: before Horizontal DErivative 
     273               &                 gtu, gsu, gru,  &  ! of t, s, rd at the bottom ocean level 
     274               &                 gtv, gsv, grv ) 
     275                   CALL zdf_mxl( kt )              ! mixed layer depth 
     276                   CALL ldf_slp( kt, rhd, rn2 ) 
     277 
     278            uslpdta (:,:,:,2) = uslp (:,:,:) 
     279            vslpdta (:,:,:,2) = vslp (:,:,:) 
     280            wslpidta(:,:,:,2) = wslpi(:,:,:) 
     281            wslpjdta(:,:,:,2) = wslpj(:,:,:) 
     282         END IF 
    311283        
    312284         ! store the information of the period read 
    … …  
    341313      CALL eos( tn, sn, rhd, rhop )  
    342314       
    343 #if ! defined key_off_degrad && defined key_traldf_c2d 
     315#if ! defined key_degrad && defined key_traldf_c2d 
    344316      ! In case of 2D varying coefficients, we need aeiv and aeiu 
    345       IF( lk_traldf_eiv )   CALL ldf_eiv( kt )      ! eddy induced velocity coefficient 
    346 #endif 
     317      IF( lk_traldf_eiv )   CALL dta_eiv( kt )      ! eddy induced velocity coefficient 
     318#endif 
     319 
     320      ! Compute bbl coefficients if needed 
     321      IF( lk_trabbl ) THEN 
     322         tb(:,:,:) = tn(:,:,:) 
     323         sb(:,:,:) = sn(:,:,:) 
     324         CALL bbl( kt, 'TRC') 
     325      END IF 
    347326    
    348327   END SUBROUTINE dta_dyn 
    … …  
    377356         zemp, zqsr, zmld, zice, zwspd, & 
    378357         ztaux, ztauy 
    379 #if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    380       REAL(wp), DIMENSION(jpi,jpj) :: zbblx, zbbly 
    381 #endif 
    382  
    383 #if ! defined key_off_degrad && defined key_traldf_c2d 
    384       REAL(wp), DIMENSION(jpi,jpj) :: zahtw  
    385 #   if defined key_trcldf_eiv 
     358 
     359#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 
    386360      REAL(wp), DIMENSION(jpi,jpj) :: zaeiw  
    387 #  endif 
    388 #endif 
    389  
    390 #if defined key_off_degrad 
     361#endif 
     362 
     363#if defined key_degrad 
    391364   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    392365      zahtu, zahtv, zahtw  !  Lateral diffusivity 
    393 # if defined key_trcldf_eiv 
     366# if defined key_traldf_eiv 
    394367   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    395368      zaeiu, zaeiv, zaeiw  ! G&M coefficient 
    … …  
    409382         WRITE(numout,*) 'Dynrea : reading dynamical fields, kenr = ', jkenr 
    410383         WRITE(numout,*) ' ~~~~~~~' 
    411 #if defined key_off_degrad 
     384#if defined key_degrad 
    412385         WRITE(numout,*) ' Degraded fields' 
    413386#endif 
    … …  
    443416      CALL iom_get( numfl_v, jpdom_data, 'vomecrty', zv   (:,:,:), jkenr ) 
    444417 
    445 #if defined key_trcbbl_dif || defined key_trcbbl_adv 
    446       IF( iom_varid( numfl_u, 'sobblcox', ldstop = .FALSE. ) > 0  .AND. & 
    447       &   iom_varid( numfl_v, 'sobblcoy', ldstop = .FALSE. ) > 0 ) THEN 
    448          CALL iom_get( numfl_u, jpdom_data, 'sobblcox', zbblx(:,:), jkenr ) 
    449          CALL iom_get( numfl_v, jpdom_data, 'sobblcoy', zbbly(:,:), jkenr ) 
    450       ELSE 
    451          CALL bbl_sign( zt, zs, zbblx, zbbly )     
    452       ENDIF 
    453 #endif 
    454  
    455418      ! file grid-W 
    456419!!      CALL iom_get ( numfl_w, jpdom_data, 'vovecrtz', zw   (:,:,:), jkenr ) 
    … …  
    464427#endif  
    465428 
    466 #if ! defined key_off_degrad && defined key_traldf_c2d 
    467       CALL iom_get( numfl_w, jpdom_data, 'soleahtw', zahtw (:,: ), jkenr ) 
    468 #  if   defined key_trcldf_eiv  
     429#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv  
    469430      CALL iom_get( numfl_w, jpdom_data, 'soleaeiw', zaeiw (:,: ), jkenr ) 
    470 #  endif 
    471 #endif 
    472  
    473 #if defined key_off_degrad 
     431#endif 
     432 
     433#if defined key_degrad 
    474434      CALL iom_get( numfl_u, jpdom_data, 'vozoahtu', zahtu(:,:,:), jkenr ) 
    475435      CALL iom_get( numfl_v, jpdom_data, 'vomeahtv', zahtv(:,:,:), jkenr ) 
    476436      CALL iom_get( numfl_w, jpdom_data, 'voveahtw', zahtw(:,:,:), jkenr ) 
    477 #  if defined key_trcldf_eiv 
     437#  if defined key_traldf_eiv 
    478438      CALL iom_get( numfl_u, jpdom_data, 'vozoaeiu', zaeiu(:,:,:), jkenr ) 
    479439      CALL iom_get( numfl_v, jpdom_data, 'vomeaeiv', zaeiv(:,:,:), jkenr ) 
    … …  
    486446      wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:) 
    487447 
    488 #if defined key_trc_diatrd 
    489       hdivdta(:,:,:,2) = zhdiv(:,:,:) * tmask(:,:,:) 
    490 #endif 
    491  
    492448      tdta(:,:,:,2)   = zt  (:,:,:) * tmask(:,:,:) 
    493449      sdta(:,:,:,2)   = zs  (:,:,:) * tmask(:,:,:) 
    494450      avtdta(:,:,:,2) = zavt(:,:,:) * tmask(:,:,:) 
    495451 
    496 #if ! defined key_off_degrad && defined key_traldf_c2d 
    497       ahtwdta(:,:,2)  = zahtw(:,:) * tmask(:,:,1) 
    498 #if defined key_trcldf_eiv 
     452#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 
    499453      aeiwdta(:,:,2)  = zaeiw(:,:) * tmask(:,:,1) 
    500454#endif 
    501 #endif 
    502  
    503 #if defined key_off_degrad 
     455 
     456#if defined key_degrad 
    504457        ahtudta(:,:,:,2) = zahtu(:,:,:) * umask(:,:,:) 
    505458        ahtvdta(:,:,:,2) = zahtv(:,:,:) * vmask(:,:,:) 
    506459        ahtwdta(:,:,:,2) = zahtw(:,:,:) * tmask(:,:,:) 
    507 #  if defined key_trcldf_eiv 
     460#  if defined key_traldf_eiv 
    508461        aeiudta(:,:,:,2) = zaeiu(:,:,:) * umask(:,:,:) 
    509462        aeivdta(:,:,:,2) = zaeiv(:,:,:) * vmask(:,:,:) 
    … …  
    520473      hmlddta(:,:,2)  = zmld(:,:) * tmask(:,:,1) 
    521474       
    522 #if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    523       bblxdta(:,:,2) = MAX( 0., zbblx(:,:) ) 
    524       bblydta(:,:,2) = MAX( 0., zbbly(:,:) ) 
    525  
    526       WHERE( bblxdta(:,:,2) > 2. ) bblxdta(:,:,2) = 0. 
    527       WHERE( bblydta(:,:,2) > 2. ) bblydta(:,:,2) = 0. 
    528 #endif 
    529  
    530475      IF( kt == nitend ) THEN 
    531476         CALL iom_close ( numfl_t ) 
    … …  
    557502      REAL(wp) ::   znspyr   !: number of time step per year 
    558503 
    559       NAMELIST/namdyn/ ndtadyn, ndtatot, nsptint, nficdyn, lperdyn,  & 
     504      NAMELIST/namdyn/ ndtadyn, ndtatot, nsptint, lperdyn,  & 
    560505      &                cfile_grid_T, cfile_grid_U, cfile_grid_V, cfile_grid_W 
    561506      !!---------------------------------------------------------------------- 
    … …  
    577522         WRITE(numout,*) ' total number of elements in the FILE       ndtatot = ' , ndtatot 
    578523         WRITE(numout,*) ' type of interpolation                      nsptint = ' , nsptint 
    579          WRITE(numout,*) ' number of dynamics FILE                    nficdyn = ' , nficdyn 
    580524         WRITE(numout,*) ' loop on the same FILE                      lperdyn = ' , lperdyn 
    581525         WRITE(numout,*) '  ' 
    … …  
    590534      rnspdta  = znspyr / FLOAT( ndtadyn ) 
    591535      rnspdta2 = rnspdta * 0.5  
     536 
     537      CALL dta_dyn( nit000 ) 
    592538 
    593539   END SUBROUTINE dta_dyn_init 
    … …  
    658604 
    659605   END SUBROUTINE wzv 
     606 
     607   SUBROUTINE dta_eiv( kt ) 
     608      !!---------------------------------------------------------------------- 
     609      !!                  ***  ROUTINE dta_eiv  *** 
     610      !! 
     611      !! ** Purpose :   Compute the eddy induced velocity coefficient from the 
     612      !!      growth rate of baroclinic instability. 
     613      !! 
     614      !! ** Method : Specific to the offline model. Computes the horizontal 
     615      !!             values from the vertical value 
     616      !! 
     617      !! History : 
     618      !!   9.0  !  06-03  (O. Aumont)  Free form, F90 
     619      !!---------------------------------------------------------------------- 
     620      !! * Arguments 
     621      INTEGER, INTENT( in ) ::   kt     ! ocean time-step inedx 
     622 
     623      !! * Local declarations 
     624      INTEGER ::   ji, jj           ! dummy loop indices 
     625      !!---------------------------------------------------------------------- 
     626 
     627      IF( kt == nit000 ) THEN 
     628         IF(lwp) WRITE(numout,*) 
     629         IF(lwp) WRITE(numout,*) 'dta_eiv : eddy induced velocity coefficients' 
     630         IF(lwp) WRITE(numout,*) '~~~~~~~' 
     631      ENDIF 
     632 
     633      ! Average the diffusive coefficient at u- v- points 
     634      DO jj = 2, jpjm1 
     635         DO ji = fs_2, fs_jpim1   ! vector opt. 
     636            aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj  ) ) 
     637            aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji  ,jj+1) ) 
     638         END DO 
     639      END DO 
     640 
     641      ! lateral boundary condition on aeiu, aeiv 
     642      CALL lbc_lnk( aeiu, 'U', 1. ) 
     643      CALL lbc_lnk( aeiv, 'V', 1. ) 
     644 
     645   END SUBROUTINE dta_eiv 
    660646 
    661647   SUBROUTINE tau2wnd( ptaux, ptauy, pwspd ) 
    … …  
    692678   END SUBROUTINE tau2wnd 
    693679 
    694 #if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    695  
    696    SUBROUTINE bbl_sign( ptn, psn, pbblx, pbbly ) 
    697       !!---------------------------------------------------------------------- 
    698       !!                    ***  ROUTINE bbl_sign  *** 
    699       !! 
    700       !! ** Purpose :   Compute the sign of local gradient of density multiplied by the slope 
    701       !!                along the bottom slope gradient : grad( rho) * grad(h) 
    702       !!                Need to compute the diffusive bottom boundary layer 
    703       !! 
    704       !! ** Method  :   When the product grad( rho) * grad(h) < 0 (where grad 
    705       !!      is an along bottom slope gradient) an additional lateral diffu- 
    706       !!      sive trend along the bottom slope is added to the general tracer 
    707       !!      trend, otherwise nothing is done. See trcbbl.F90 
    708       !! 
    709       !! 
    710       !! History : 
    711       !!   9.0  !  02-07  (G. Madec)  Vector optimization 
    712       !!---------------------------------------------------------------------- 
    713       !! * Arguments 
    714       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in  ) ::  & 
    715          ptn             ,  &                           !: temperature  
    716          psn                                            !: salinity  
    717       REAL(wp), DIMENSION(jpi,jpj), INTENT( out ) ::  & 
    718          pbblx , pbbly                                  !: sign of bbl in i-j direction resp.  
    719        
    720       !! * Local declarations 
    721       INTEGER  ::   ji, jj                   ! dummy loop indices 
    722       INTEGER  ::   ik 
    723       REAL(wp) ::   & 
    724          ztx, zsx, zhx, zalbetx, zgdrhox,     &  ! temporary scalars 
    725          zty, zsy, zhy, zalbety, zgdrhoy  
    726       REAL(wp), DIMENSION(jpi,jpj) ::    & 
    727         ztnb, zsnb, zdep 
    728       REAL(wp) ::    fsalbt, pft, pfs, pfh   ! statement function 
    729       !!---------------------------------------------------------------------- 
    730       ! ratio alpha/beta 
    731       ! ================ 
    732       !  fsalbt: ratio of thermal over saline expension coefficients 
    733       !       pft :  potential temperature in degrees celcius 
    734       !       pfs :  salinity anomaly (s-35) in psu 
    735       !       pfh :  depth in meters 
    736  
    737       fsalbt( pft, pfs, pfh ) =                                              & 
    738          ( ( ( -0.255019e-07 * pft + 0.298357e-05 ) * pft                    & 
    739                                    - 0.203814e-03 ) * pft                    & 
    740                                    + 0.170907e-01 ) * pft                    & 
    741                                    + 0.665157e-01                            & 
    742          +(-0.678662e-05 * pfs - 0.846960e-04 * pft + 0.378110e-02 ) * pfs   & 
    743          +  ( ( - 0.302285e-13 * pfh                                         & 
    744                 - 0.251520e-11 * pfs                                         & 
    745                 + 0.512857e-12 * pft * pft          ) * pfh                  & 
    746                                      - 0.164759e-06   * pfs                  & 
    747              +(   0.791325e-08 * pft - 0.933746e-06 ) * pft                  & 
    748                                      + 0.380374e-04 ) * pfh 
    749  
    750       ! 0. 2D fields of bottom temperature and salinity, and bottom slope 
    751       ! ----------------------------------------------------------------- 
    752       ! mbathy= number of w-level, minimum value=1 (cf domrea.F90) 
    753 #  if defined key_vectopt_loop 
    754       jj = 1 
    755       DO ji = 1, jpij   ! vector opt. (forced unrolling) 
    756 #  else 
    757       DO jj = 1, jpj 
    758          DO ji = 1, jpi 
    759 #  endif 
    760             ik          =  MAX( mbathy(ji,jj) - 1, 1 )    ! vertical index of the bottom ocean T-level 
    761             ztnb(ji,jj) = ptn(ji,jj,ik) * tmask(ji,jj,1)  ! masked T and S at ocean bottom 
    762             zsnb(ji,jj) = psn(ji,jj,ik) * tmask(ji,jj,1) 
    763             zdep(ji,jj) = fsdept(ji,jj,ik)                ! depth of the ocean bottom T-level 
    764 #  if ! defined key_vectopt_loop 
    765          END DO 
    766 #  endif 
    767       END DO 
    768  
    769       !!---------------------------------------------------------------------- 
    770       ! 1. Criteria of additional bottom diffusivity: grad(rho).grad(h)<0 
    771       ! -------------------------------------------- 
    772       ! Sign of the local density gradient along the i- and j-slopes 
    773       ! multiplied by the slope of the ocean bottom 
    774  
    775       SELECT CASE ( neos ) 
    776  
    777       CASE ( 0 )                 ! Jackett and McDougall (1994) formulation 
    778  
    779 #  if defined key_vectopt_loop 
    780       jj = 1 
    781       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    782 #  else 
    783       DO jj = 1, jpjm1 
    784          DO ji = 1, jpim1 
    785 #  endif 
    786             ! temperature, salinity anomalie and depth 
    787             ztx = 0.5 * ( ztnb(ji,jj) + ztnb(ji+1,jj) ) 
    788             zsx = 0.5 * ( zsnb(ji,jj) + zsnb(ji+1,jj) ) - 35.0 
    789             zhx = 0.5 * ( zdep(ji,jj) + zdep(ji+1,jj) ) 
    790             ! 
    791             zty = 0.5 * ( ztnb(ji,jj+1) + ztnb(ji,jj) ) 
    792             zsy = 0.5 * ( zsnb(ji,jj+1) + zsnb(ji,jj) ) - 35.0 
    793             zhy = 0.5 * ( zdep(ji,jj+1) + zdep(ji,jj) ) 
    794             ! masked ratio alpha/beta 
    795             zalbetx = fsalbt( ztx, zsx, zhx ) * umask(ji,jj,1) 
    796             zalbety = fsalbt( zty, zsy, zhy ) * vmask(ji,jj,1) 
    797             ! local density gradient along i-bathymetric slope 
    798             zgdrhox = zalbetx * ( ztnb(ji+1,jj) - ztnb(ji,jj) )   & 
    799                    -            ( zsnb(ji+1,jj) - zsnb(ji,jj) ) 
    800             ! local density gradient along j-bathymetric slope 
    801             zgdrhoy = zalbety * ( ztnb(ji,jj+1) - ztnb(ji,jj) )   & 
    802                    -            ( zsnb(ji,jj+1) - zsnb(ji,jj) ) 
    803             ! sign of local i-gradient of density multiplied by the i-slope 
    804             pbblx(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhox * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    805             ! sign of local j-gradient of density multiplied by the j-slope 
    806             pbbly(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhoy * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    807 #  if ! defined key_vectopt_loop 
    808          END DO 
    809 #  endif 
    810       END DO 
    811  
    812       CASE ( 1 )               ! Linear formulation function of temperature only 
    813                                ! 
    814 #  if defined key_vectopt_loop 
    815       jj = 1 
    816       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    817 #  else 
    818       DO jj = 1, jpjm1 
    819          DO ji = 1, jpim1 
    820 #  endif 
    821             ! local 'density/temperature' gradient along i-bathymetric slope 
    822             zgdrhox =  ztnb(ji+1,jj) - ztnb(ji,jj) 
    823             ! local density gradient along j-bathymetric slope 
    824             zgdrhoy =  ztnb(ji,jj+1) - ztnb(ji,jj) 
    825             ! sign of local i-gradient of density multiplied by the i-slope 
    826             pbblx(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhox * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    827             ! sign of local j-gradient of density multiplied by the j-slope 
    828             pbbly(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhoy * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    829 #  if ! defined key_vectopt_loop 
    830          END DO 
    831 #  endif 
    832       END DO 
    833  
    834       CASE ( 2 )               ! Linear formulation function of temperature and salinity 
    835  
    836 #  if defined key_vectopt_loop 
    837       jj = 1 
    838       DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    839 #  else 
    840       DO jj = 1, jpjm1 
    841          DO ji = 1, jpim1 
    842 #  endif      
    843             ! local density gradient along i-bathymetric slope 
    844             zgdrhox = - ( rbeta*( zsnb(ji+1,jj) - zsnb(ji,jj) )   & 
    845                       -  ralpha*( ztnb(ji+1,jj) - ztnb(ji,jj) ) ) 
    846             ! local density gradient along j-bathymetric slope 
    847             zgdrhoy = - ( rbeta*( zsnb(ji,jj+1) - zsnb(ji,jj) )   & 
    848                       -  ralpha*( ztnb(ji,jj+1) - ztnb(ji,jj) ) ) 
    849             ! sign of local i-gradient of density multiplied by the i-slope 
    850             pbblx(ji,jj) = 0.5 - SIGN( 0.5, - zgdrhox * ( zdep(ji+1,jj) - zdep(ji,jj) ) ) 
    851             ! sign of local j-gradient of density multiplied by the j-slope 
    852             pbbly(ji,jj) = 0.5 - SIGN( 0.5, -zgdrhoy * ( zdep(ji,jj+1) - zdep(ji,jj) ) ) 
    853 #  if ! defined key_vectopt_loop 
    854          END DO 
    855 #  endif 
    856       END DO 
    857  
    858       CASE DEFAULT 
    859  
    860          WRITE(ctmp1,*) '          bad flag value for neos = ', neos 
    861          CALL ctl_stop(ctmp1) 
    862  
    863       END SELECT 
    864     
    865       ! Lateral boundary conditions 
    866       CALL lbc_lnk( pbblx, 'U', 1. ) 
    867       CALL lbc_lnk( pbbly, 'V', 1. ) 
    868  
    869    END SUBROUTINE bbl_sign 
    870  
    871 #endif 
    872  
    873680   SUBROUTINE swap_dyn_data 
    874681      !!---------------------------------------------------------------------- 
    … …  
    889696      vdta   (:,:,:,1) = vdta   (:,:,:,2) 
    890697      wdta   (:,:,:,1) = wdta   (:,:,:,2) 
    891 #if defined key_trc_diatrd 
    892       hdivdta(:,:,:,1) = hdivdta(:,:,:,2) 
    893 #endif 
    894698 
    895699#if defined key_ldfslp 
    … …  
    905709      qsrdta (:,:,1) = qsrdta (:,:,2)  
    906710 
    907 #if ! defined key_off_degrad && defined key_traldf_c2d 
    908       ahtwdta(:,:,1) = ahtwdta(:,:,2) 
    909 #  if defined key_trcldf_eiv 
     711#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 
    910712      aeiwdta(:,:,1) = aeiwdta(:,:,2) 
    911 #  endif 
    912 #endif 
    913  
    914 #if defined key_off_degrad 
     713#endif 
     714 
     715#if defined key_degrad 
    915716      ahtudta(:,:,:,1) = ahtudta(:,:,:,2) 
    916717      ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2) 
    917718      ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2) 
    918 #  if defined key_trcldf_eiv 
     719#  if defined key_traldf_eiv 
    919720      aeiudta(:,:,:,1) = aeiudta(:,:,:,2) 
    920721      aeivdta(:,:,:,1) = aeivdta(:,:,:,2) 
    … …  
    923724#endif 
    924725 
    925 #if defined key_trcbbl_dif || defined key_trcbbl_adv 
    926       bblxdta(:,:,1) = bblxdta(:,:,2) 
    927       bblydta(:,:,1) = bblydta(:,:,2) 
    928 #endif 
    929  
    930726   END SUBROUTINE swap_dyn_data 
    931727 
    … …  
    946742      vn (:,:,:) = vdta  (:,:,:,2) 
    947743      wn (:,:,:) = wdta  (:,:,:,2) 
    948  
    949 #if defined key_trc_diatrd 
    950       hdivn(:,:,:) = hdivdta(:,:,:,2) 
    951 #endif 
    952744 
    953745#if defined key_zdfddm 
    … …  
    970762      qsr (:,:) = qsrdta (:,:,2)  
    971763 
    972 #if ! defined key_off_degrad && defined key_traldf_c2d     
    973       ahtw(:,:) = ahtwdta(:,:,2) 
    974 #  if defined key_trcldf_eiv 
     764#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv 
    975765      aeiw(:,:) = aeiwdta(:,:,2) 
    976 #  endif 
    977 #endif 
    978        
    979 #if defined key_off_degrad 
     766#endif 
     767       
     768#if defined key_degrad 
    980769      ahtu(:,:,:) = ahtudta(:,:,:,2) 
    981770      ahtv(:,:,:) = ahtvdta(:,:,:,2) 
    982771      ahtw(:,:,:) = ahtwdta(:,:,:,2) 
    983 #  if defined key_trcldf_eiv 
     772#  if defined key_traldf_eiv 
    984773      aeiu(:,:,:) = aeiudta(:,:,:,2) 
    985774      aeiv(:,:,:) = aeivdta(:,:,:,2) 
    … …  
    989778#endif 
    990779       
    991 #if defined key_trcbbl_dif ||  defined key_trcbbl_adv 
    992       bblx(:,:) = bblxdta(:,:,2) 
    993       bbly(:,:) = bblydta(:,:,2) 
    994 #endif 
    995  
    996780   END SUBROUTINE assign_dyn_data 
    997781 
    … …  
    1019803      vn (:,:,:) = zweighm1 * vdta  (:,:,:,1) + pweigh * vdta  (:,:,:,2) 
    1020804      wn (:,:,:) = zweighm1 * wdta  (:,:,:,1) + pweigh * wdta  (:,:,:,2) 
    1021  
    1022 #if defined key_trc_diatrd 
    1023       hdivn(:,:,:) = zweighm1 * hdivdta(:,:,:,1) + pweigh * hdivdta(:,:,:,2) 
    1024 #endif 
    1025805 
    1026806#if defined key_zdfddm 
    … …  
    1043823      qsr (:,:) = zweighm1 * qsrdta (:,:,1) + pweigh  * qsrdta (:,:,2)  
    1044824 
    1045 #if ! defined key_off_degrad && defined key_traldf_c2d     
    1046       ahtw(:,:) = zweighm1 * ahtwdta(:,:,1) + pweigh * ahtwdta(:,:,2) 
    1047 #  if defined key_trcldf_eiv 
     825#if ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv  
    1048826      aeiw(:,:) = zweighm1 * aeiwdta(:,:,1) + pweigh * aeiwdta(:,:,2) 
    1049 #  endif 
    1050 #endif 
    1051        
    1052 #if defined key_off_degrad 
     827#endif 
     828       
     829#if defined key_degrad 
    1053830      ahtu(:,:,:) = zweighm1 * ahtudta(:,:,:,1) + pweigh * ahtudta(:,:,:,2) 
    1054831      ahtv(:,:,:) = zweighm1 * ahtvdta(:,:,:,1) + pweigh * ahtvdta(:,:,:,2) 
    1055832      ahtw(:,:,:) = zweighm1 * ahtwdta(:,:,:,1) + pweigh * ahtwdta(:,:,:,2) 
    1056 #  if defined key_trcldf_eiv 
     833#  if defined key_traldf_eiv 
    1057834      aeiu(:,:,:) = zweighm1 * aeiudta(:,:,:,1) + pweigh * aeiudta(:,:,:,2) 
    1058835      aeiv(:,:,:) = zweighm1 * aeivdta(:,:,:,1) + pweigh * aeivdta(:,:,:,2) 
    … …  
    1061838#endif 
    1062839       
    1063 #if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    1064       bblx(:,:) = zweighm1 * bblxdta(:,:,1) + pweigh * bblxdta(:,:,2) 
    1065       bbly(:,:) = zweighm1 * bblydta(:,:,1) + pweigh * bblydta(:,:,2) 
    1066 #endif 
    1067  
    1068840   END SUBROUTINE linear_interp_dyn_data 
    1069841 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OFF_SRC/opa.F90

    r1749 r2053  
    2121 
    2222   ! ocean physics 
    23    USE ldftra          ! lateral diffusivity setting    (ldftra_init routine) 
    24    USE traqsr          ! solar radiation penetration   (tra_qsr_init routine) 
     23   USE ldftra          ! lateral diffusivity setting    (ldf_tra_init routine) 
     24   USE ldfslp          ! slopes of neutral surfaces     (ldf_slp_init routine) 
     25   USE traqsr          ! solar radiation penetration    (tra_qsr_init routine) 
     26   USE trabbl          ! bottom boundary layer          (tra_bbl_init routine) 
     27   USE zpshde          ! partial step: hor. derivative  (zps_hde_init routine) 
     28   USE zdfini 
     29   USE zdfddm 
     30   USE zdfkpp 
    2531 
    2632   USE phycst          ! physical constant                  (par_cst routine) 
    2733   USE dtadyn          ! Lecture and Interpolation of the dynamical fields 
    2834   USE trcini          ! Initilization of the passive tracers 
    29    USE step            ! OPA time-stepping                  (stp     routine) 
     35   USE stpctl 
     36   USE daymod          ! calendar                         (day     routine) 
     37   USE trcstp          ! passive tracer time-stepping      (trc_stp routine) 
     38   USE dtadyn          ! Lecture and interpolation of the dynamical fields 
     39   USE stpctl          ! time stepping control            (stp_ctl routine) 
    3040 
    3141   USE iom 
    … …  
    6676      !!              internal report, IPSL. 
    6777      !!---------------------------------------------------------------------- 
    68       INTEGER ::   istp       ! time step index 
     78      INTEGER :: istp, indic       ! time step index 
    6979      !!---------------------------------------------------------------------- 
    7080 
    … …  
    8090         ! 
    8191      DO WHILE ( istp <= nitend .AND. nstop == 0 ) 
    82          CALL stp( istp ) 
     92         ! 
     93         IF( istp /= nit000 )   CALL day      ( istp )   ! Calendar (day was already called at nit000 in day_init) 
     94                                CALL iom_setkt( istp )   ! say to iom that we are at time step kstp 
     95                                CALL dta_dyn  ( istp )   ! Interpolation of the dynamical fields 
     96                                CALL trc_stp  ( istp )   ! time-stepping 
     97                                CALL stp_ctl  ( istp, indic )   ! Time loop: control and print 
    8398         istp = istp + 1 
    8499         IF( lk_mpp )   CALL mpp_max( nstop ) 
    … …  
    134149      !!---------------------------------------------------------------------- 
    135150      !! * Local declarations 
     151#if defined key_oasis3 || defined key_oasis4 || defined key_iomput 
     152      INTEGER :: ilocal_comm 
     153#endif 
     154      CHARACTER(len=80),dimension(10) ::   cltxt = '' 
     155      INTEGER                         ::   ji   ! local loop indices 
     156      !! 
     157      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   & 
     158         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle, nn_bench 
     159      !!---------------------------------------------------------------------- 
     160 
     161      ! 
     162      !                             ! open Namelist file      
     163      CALL ctl_opn( numnam, 'namelist', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 
     164      ! 
     165      READ( numnam, namctl )        ! Namelist namctl : Control prints & Benchmark 
     166      ! 
     167      !                             !--------------------------------------------! 
     168      !                             !  set communicator & select the local node  ! 
     169      !                             !--------------------------------------------! 
    136170#if defined key_iomput 
    137       INTEGER :: localComm 
     171# if defined key_oasis3 || defined key_oasis4    
     172      CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
     173      CALL init_ioclient()                    ! io_server will get its communicators (if needed) from oasis (we don't see it) 
     174# else 
     175      CALL init_ioclient( ilocal_comm )       ! nemo local communicator (used or not) given by the io_server 
     176# endif 
     177      narea = mynode( cltxt, ilocal_comm )    ! Nodes selection 
     178 
     179#else 
     180# if defined key_oasis3 || defined key_oasis4    
     181      CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
     182      narea = mynode( cltxt, ilocal_comm )    ! Nodes selection (control print return in cltxt) 
     183# else 
     184      narea = mynode( cltxt )                 ! Nodes selection (control print return in cltxt) 
     185# endif 
    138186#endif 
    139       CHARACTER (len=20) ::   namelistname 
    140       CHARACTER (len=28) ::   file_out 
    141       NAMELIST/namctl/ ln_ctl, nprint, nictls, nictle,   & 
    142          &             isplt , jsplt , njctls, njctle, nbench 
    143  
    144       !!---------------------------------------------------------------------- 
    145  
    146       ! Initializations 
    147       ! =============== 
    148  
    149       file_out = 'ocean.output' 
    150  
    151       ! open listing and namelist units 
    152       CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED',   & 
    153          &         'SEQUENTIAL', 1, 6, .FALSE., 1 ) 
    154  
    155       namelistname = 'namelist' 
    156       CALL ctlopn( numnam, namelistname, 'OLD', 'FORMATTED', 'SEQUENTIAL',   & 
    157          &         1, numout, .FALSE., 1 ) 
    158  
    159       WRITE(numout,*) 
    160       WRITE(numout,*) '                 L O D Y C - I P S L' 
    161       WRITE(numout,*) '                     O P A model' 
    162       WRITE(numout,*) '            Ocean General Circulation Model' 
    163       WRITE(numout,*) '               version OPA 9.0  (2005) ' 
    164       WRITE(numout,*) 
    165       WRITE(numout,*) 
    166  
    167       ! Namelist namctl : Control prints & Benchmark 
    168       REWIND( numnam ) 
    169       READ  ( numnam, namctl ) 
    170  
    171 #if defined key_iomput 
    172       CALL init_ioclient(localcomm) 
    173       narea = mynode(localComm) 
    174 #else 
    175       ! Nodes selection 
    176       narea = mynode() 
    177 #endif 
    178  
    179       ! Nodes selection 
    180       narea = narea + 1    ! mynode return the rank of proc (0 --> jpnij -1 ) 
    181       lwp   = narea == 1 
    182  
    183       ! open additionnal listing 
    184       IF( ln_ctl )   THEN 
    185          IF( narea-1 > 0 )   THEN 
    186             WRITE(file_out,FMT="('ocean.output_',I4.4)") narea-1 
    187             CALL ctlopn( numout, file_out, 'UNKNOWN', 'FORMATTED',   & 
    188                &         'SEQUENTIAL', 1, numout, .FALSE., 1 ) 
    189             lwp = .TRUE. 
    190             ! 
    191             WRITE(numout,*) 
    192             WRITE(numout,*) '                 L O D Y C - I P S L' 
    193             WRITE(numout,*) '                     O P A model' 
    194             WRITE(numout,*) '            Ocean General Circulation Model' 
    195             WRITE(numout,*) '               version OPA 9.0  (2005) ' 
    196             WRITE(numout,*) '                   MPI Ocean output ' 
    197             WRITE(numout,*) 
    198             WRITE(numout,*) 
    199          ENDIF 
     187      narea = narea + 1                       ! mynode return the rank of proc (0 --> jpnij -1 ) 
     188 
     189      lwp = (narea == 1) .OR. ln_ctl          ! control of all listing output print 
     190 
     191      IF(lwp) THEN                            ! open listing units 
     192         ! 
     193         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     194         ! 
     195         WRITE(numout,*) 
     196         WRITE(numout,*) '         CNRS - NERC - Met OFFICE - MERCATOR-ocean' 
     197         WRITE(numout,*) '                       NEMO team' 
     198         WRITE(numout,*) '            Ocean General Circulation Model' 
     199         WRITE(numout,*) '                  version 3.2  (2009) ' 
     200         WRITE(numout,*) 
     201         WRITE(numout,*) 
     202         DO ji = 1, SIZE(cltxt)  
     203            IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode 
     204         END DO 
     205         WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA 
     206         ! 
    200207      ENDIF 
    201208 
    … …  
    209216 
    210217                                            ! Domain decomposition 
    211       IF( jpni * jpnj == jpnij ) THEN 
    212          CALL mpp_init                          ! standard cutting out 
    213       ELSE 
    214          CALL mpp_init2                         ! eliminate land processors 
    215       ENDIF 
    216        
    217       CALL phy_cst                          ! Physical constants 
    218       CALL eos_init                         ! Equation of state 
    219       CALL dom_cfg                          ! Domain configuration 
    220       CALL dom_init                         ! Domain 
    221       CALL istate_init                      ! ocean initial state (Dynamics and tracers) 
    222       CALL trc_ini                           ! Passive tracers 
    223       CALL dta_dyn( nit000 )                 ! Initialization for the dynamics 
    224       CALL tra_qsr_init                         ! Solar radiation penetration 
    225 #if ! defined key_off_degrad 
    226       CALL ldf_tra_init                         ! Lateral ocean tracer physics 
    227 #endif  
    228       CALL iom_init                         ! iom_put initialization 
     218                                            ! Domain decomposition 
     219      IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out 
     220      ELSE                            ;   CALL mpp_init2     ! eliminate land processors 
     221      ENDIF 
     222 
     223 
     224 
     225                            CALL     phy_cst    ! Physical constants 
     226                            CALL     eos_init   ! Equation of state 
     227                            CALL     dom_cfg    ! Domain configuration 
     228                            CALL     dom_init   ! Domain 
     229 
     230      IF( ln_zps        )   CALL zps_hde_init   ! Partial steps:  horizontal derivative 
     231                            CALL  istate_init   ! ocean initial state (Dynamics and tracers) 
     232 
     233      !                                     ! Ocean physics 
     234      IF( lk_zdfddm .AND. .NOT. lk_zdfkpp )   & 
     235         &                  CALL zdf_ddm_init   ! double diffusive mixing 
     236      !                                     ! Lateral physics 
     237#if ! defined key_degrad 
     238                            CALL ldf_tra_init   ! Lateral ocean tracer physics 
     239#endif 
     240      IF( lk_ldfslp )       CALL ldf_slp_init   ! slope of lateral mixing 
     241      !                                     ! Active tracers 
     242                            CALL tra_qsr_init   ! penetrative solar radiation qsr 
     243      IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme 
     244 
     245                            CALL     trc_ini    ! Passive tracers 
     246                            CALL dta_dyn_init   ! Initialization for the dynamics 
     247                            CALL     iom_init       ! iom_put initialization 
    229248 
    230249      IF(lwp) WRITE(numout,cform_aaa)       ! Flag AAAAAAA 
    … …  
    236255      !!                     ***  ROUTINE opa  *** 
    237256      !! 
    238       !! ** Purpose :   Initialize logical flags that control the choice of 
    239       !!      some algorithm or control print 
    240       !! 
    241       !! ** Method  :    Read in namilist namflg logical flags 
    242       !! 
    243       !! History : 
    244       !!   9.0  !  03-11  (G. Madec)  Original code 
    245       !!---------------------------------------------------------------------- 
    246       !! * Local declarations 
    247  
    248       ! Parameter control and print 
    249       ! --------------------------- 
    250       IF(lwp) THEN 
     257      !! ** Purpose :   Initialise logical flags that control the choice of 
     258      !!              some algorithm or control print 
     259      !! 
     260      !! ** Method  : - print namctl information 
     261      !!              - Read in namilist namflg logical flags 
     262      !!---------------------------------------------------------------------- 
     263 
     264      IF(lwp) THEN                 ! Parameter print 
    251265         WRITE(numout,*) 
    252266         WRITE(numout,*) 'opa_flg: Control prints & Benchmark' 
    253267         WRITE(numout,*) '~~~~~~~ ' 
    254          WRITE(numout,*) '          Namelist namctl' 
    255          WRITE(numout,*) '             run control (for debugging)     ln_ctl    = ', ln_ctl 
    256          WRITE(numout,*) '             level of print                  nprint    = ', nprint 
    257          WRITE(numout,*) '             Start i indice for SUM control  nictls    = ', nictls 
    258          WRITE(numout,*) '             End i indice for SUM control    nictle    = ', nictle 
    259          WRITE(numout,*) '             Start j indice for SUM control  njctls    = ', njctls 
    260          WRITE(numout,*) '             End j indice for SUM control    njctle    = ', njctle 
    261          WRITE(numout,*) '             number of proc. following i     isplt     = ', isplt 
    262          WRITE(numout,*) '             number of proc. following j     jsplt     = ', jsplt 
    263          WRITE(numout,*) '             benchmark parameter (0/1)       nbench    = ', nbench 
    264       ENDIF 
    265  
    266       ! ... Control the sub-domain area indices for the control prints 
    267       IF( ln_ctl )   THEN 
    268          IF( lk_mpp )   THEN 
    269             ! the domain is forced to the real splitted domain in MPI 
    270             isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj 
     268         WRITE(numout,*) '   Namelist namctl' 
     269         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl 
     270         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
     271         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
     272         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
     273         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
     274         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
     275         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
     276         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
     277         WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench 
     278      ENDIF 
     279 
     280      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
     281      nictls    = nn_ictls 
     282      nictle    = nn_ictle 
     283      njctls    = nn_jctls 
     284      njctle    = nn_jctle 
     285      isplt     = nn_isplt 
     286      jsplt     = nn_jsplt 
     287      nbench    = nn_bench 
     288      !                           ! Parameter control 
     289      ! 
     290      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints 
     291         IF( lk_mpp ) THEN 
     292            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real splitted domain 
    271293         ELSE 
    272294            IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    273                CALL ctl_warn( '          - isplt & jsplt are equal to 1',   & 
    274                     &         '          - the print control will be done over the whole domain' ) 
    275             ENDIF 
    276  
    277             ! compute the total number of processors ijsplt 
    278             ijsplt = isplt*jsplt 
     295               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
     296                  &           ' - the print control will be done over the whole domain' ) 
     297            ENDIF 
     298            ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    279299         ENDIF 
    280  
    281300         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    282301         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    283  
    284          ! Control the indices used for the SUM control 
    285          IF( nictls+nictle+njctls+njctle == 0 )   THEN 
    286             ! the print control is done over the default area 
     302         ! 
     303         !                              ! indices used for the SUM control 
     304         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    287305            lsp_area = .FALSE. 
    288          ELSE 
    289             ! the print control is done over a specific  area 
     306         ELSE                                             ! print control done over a specific  area 
    290307            lsp_area = .TRUE. 
    291308            IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
    … …  
    293310               nictls = 1 
    294311            ENDIF 
    295  
    296312            IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    297313               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    298314               nictle = jpiglo 
    299315            ENDIF 
    300  
    301316            IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    302317               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    303318               njctls = 1 
    304319            ENDIF 
    305  
    306320            IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    307321               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    308322               njctle = jpjglo 
    309323            ENDIF 
    310  
    311          ENDIF          ! IF( nictls+nictle+njctls+njctle == 0 ) 
    312        ENDIF            ! IF(ln_ctl) 
    313  
    314       IF( nbench == 1 )   THEN 
     324         ENDIF 
     325      ENDIF 
     326 
     327      IF( nbench == 1 )   THEN            ! Benchmark  
    315328         SELECT CASE ( cp_cfg ) 
    316          CASE ( 'gyre' ) 
    317             CALL ctl_warn( '          The Benchmark is activated ' ) 
    318          CASE DEFAULT 
    319             CALL ctl_stop( '          The Benchmark is based on the GYRE configuration: key_gyre must & 
    320                &                      be used or set nbench = 0' ) 
     329         CASE ( 'gyre' )   ;   CALL ctl_warn( ' The Benchmark is activated ' ) 
     330         CASE DEFAULT      ;   CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:',   & 
     331            &                                 ' key_gyre must be used or set nbench = 0' ) 
    321332         END SELECT 
    322333      ENDIF 

  • branches/DEV_r2006_merge_TRA_TRC/NEMO/OFF_SRC/stpctl.F90

    r1152 r2053  
    11MODULE stpctl 
    2    !!============================================================================== 
     2   !!====================================================================== 
    33   !!                       ***  MODULE  stpctl  *** 
    44   !! Ocean run control :  gross check of the ocean time stepping 
    5    !!============================================================================== 
     5   !!====================================================================== 
     6   !! History :  OPA  ! 1991-03  (G. Madec) Original code 
     7   !!            6.0  ! 1992-06  (M. Imbard) 
     8   !!            8.0  ! 1997-06  (A.M. Treguier) 
     9   !!   NEMO     1.0  ! 2002-06  (G. Madec)  F90: Free form and module 
     10   !!            2.0  ! 2009-07  (G. Madec)  Add statistic for time-spliting 
     11   !!---------------------------------------------------------------------- 
    612 
    713   !!---------------------------------------------------------------------- 
    814   !!   stp_ctl      : Control the run 
    915   !!---------------------------------------------------------------------- 
    10    !! * Modules used 
    1116   USE oce             ! ocean dynamics and tracers variables 
    1217   USE dom_oce         ! ocean space and time domain variables  
    … …  
    1823   PRIVATE 
    1924 
    20    !! * Accessibility 
    2125   PUBLIC stp_ctl           ! routine called by step.F90 
     26   !!---------------------------------------------------------------------- 
     27   !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
     28   !! $Id$ 
     29   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    2230   !!---------------------------------------------------------------------- 
    2331 
    2432CONTAINS 
    2533 
    26    SUBROUTINE stp_ctl( kt ) 
     34   SUBROUTINE stp_ctl( kt, kindic ) 
    2735      !!---------------------------------------------------------------------- 
    2836      !!                    ***  ROUTINE stp_ctl  *** 
    … …  
    3240      !! ** Method  : - Save the time step in numstp 
    3341      !!              - Print it each 50 time steps 
    34       !!              - Print solver statistics in numsol  
    35       !!              - Stop the run IF problem for the solver ( indec < 0 ) 
    3642      !! 
    37       !! History : 
    38       !!        !  91-03  () 
    39       !!        !  91-11  (G. Madec) 
    40       !!        !  92-06  (M. Imbard) 
    41       !!        !  97-06  (A.M. Treguier) 
    42       !!   8.5  !  02-06  (G. Madec)  F90: Free form and module 
     43      !! ** Actions :   'time.step' file containing the last ocean time-step 
     44      !!                 
    4345      !!---------------------------------------------------------------------- 
    44       !! * Arguments 
    4546      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index 
    46  
    47       !!---------------------------------------------------------------------- 
    48       !!   OPA 9.0 , LOCEAN-IPSL  (2005) 
    49       !!   $Id$ 
    50       !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     47      INTEGER, INTENT( inout ) ::   kindic  ! indicator of solver convergence 
    5148      !!---------------------------------------------------------------------- 
    5249 
    … …  
    5653         WRITE(numout,*) '~~~~~~~' 
    5754         ! open time.step file 
    58          CALL ctlopn( numstp, 'time.step', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, 1 ) 
     55         CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    5956      ENDIF 
    6057 
    61       ! save the current time step in numstp 
    62       ! ------------------------------------ 
    63       IF(lwp) WRITE(numstp,9100) kt 
    64       IF(lwp) REWIND(numstp) 
    65 9100  FORMAT(1x, i8) 
     58      IF(lwp) WRITE ( numstp, '(1x, i8)' )   kt      !* save the current time step in numstp 
     59      IF(lwp) REWIND( numstp )                       !  -------------------------- 
    6660 
    67  
     61      ! 
    6862   END SUBROUTINE stp_ctl 
    6963 
Note: See TracChangeset for help on using the changeset viewer.