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

Changeset 2789 for branches


Ignore:
Timestamp:
2011-06-27T13:18:25+02:00 (13 years ago)
Author:
cetlod
Message:

Implementation of the merge of TRA/TRP : first guess, see ticket #842

Location:
branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM
Files:
1 added
3 deleted
67 edited

Legend:

Unmodified
Added
Removed

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/CONFIG/GYRE/EXP00/namelist

    r2715 r2789  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    22!! NEMO/OPA  :  1 - run manager      (namrun) 
    3 !! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal) 
     3!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd) 
    44!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 
    55!!                                    namsbc_cpl, namsbc_cpl_co2 namtra_qsr, namsbc_rnf,  
    … …  
    5151!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate 
    5252!!   namdom       space and time domain (bathymetry, mesh, timestep) 
    53 !!   namdta_tem   data: temperature                                     ("key_dtatem") 
    54 !!   namdta_sal   data: salinity                                        ("key_dtasal") 
     53!!   namtsd       data: temperature & salinity          
    5554!!====================================================================== 
    5655! 
    … …  
    9493/ 
    9594!----------------------------------------------------------------------- 
    96 &namdta_tem    !   data : temperature                                   ("key_dtatem") 
    97 !----------------------------------------------------------------------- 
    98 !              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    99 !              !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
    100    sn_tem = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' ' 
     95&namtsd    !   data : Temperature  & Salinity                            
     96!----------------------------------------------------------------------- 
     97!          ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
     98!          !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
     99   sn_tem  = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' ' 
     100   sn_sal  = 'data_1m_salinity_nomask'             , -1,'vosaline',  .true.  , .true., 'yearly'   , ''       , ' ' 
    101101   ! 
    102    cn_dir       = './'     !  root directory for the location of the runoff files 
    103 / 
    104 !----------------------------------------------------------------------- 
    105 &namdta_sal    !   data : salinity                                      ("key_dtasal") 
    106 !----------------------------------------------------------------------- 
    107 !              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    108 !              !           !  (if <0  months)     !   name   !   (logical)  ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
    109    sn_sal      =  'data_1m_salinity_nomask',  -1  ,'vosaline',    .true.    , .true., 'yearly'   , ''       , ' ' 
    110    ! 
    111    cn_dir      = './'      !  root directory for the location of the runoff files 
    112 / 
    113  
     102   cn_dir        = './'      !  root directory for the location of the runoff files 
     103   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F) 
     104   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F) 
     105/ 
    114106!!====================================================================== 
    115107!!            ***  Surface Boundary Condition namelists  *** 
    … …  
    442434!!   namtra_adv    advection scheme 
    443435!!   namtra_ldf    lateral diffusion scheme 
    444 !!   namtra_dmp    T & S newtonian damping                              ("key_tradmp") 
     436!!   namtra_dmp    T & S newtonian damping                         
    445437!!====================================================================== 
    446438! 
    … …  
    483475/ 
    484476!----------------------------------------------------------------------- 
    485 &namtra_dmp    !   tracer: T & S newtonian damping                      ('key_tradmp') 
    486 !----------------------------------------------------------------------- 
     477&namtra_dmp    !   tracer: T & S newtonian damping                       
     478!----------------------------------------------------------------------- 
     479   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F) 
    487480   nn_hdmp     =   -1      !  horizontal shape =-1, damping in Med and Red Seas only 
    488481                           !                   =XX, damping poleward of XX degrees (XX>0) 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist

    r2715 r2789  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    22!! NEMO/OPA  :  1 - run manager      (namrun) 
    3 !! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal) 
     3!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd) 
    44!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 
    55!!                                    namsbc_cpl, namsbc_cpl_co2 namtra_qsr, namsbc_rnf,  
    … …  
    5151!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate 
    5252!!   namdom       space and time domain (bathymetry, mesh, timestep) 
    53 !!   namdta_tem   data: temperature                                     ("key_dtatem") 
    54 !!   namdta_sal   data: salinity                                        ("key_dtasal") 
     53!!   namtsd       data: temperature & salinity                          
    5554!!====================================================================== 
    5655! 
    … …  
    9493/ 
    9594!----------------------------------------------------------------------- 
    96 &namdta_tem    !   data : temperature                                   ("key_dtatem") 
    97 !----------------------------------------------------------------------- 
    98 !              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    99 !              !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
    100    sn_tem = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' ' 
     95&namtsd    !   data : Temperature  & Salinity                            
     96!----------------------------------------------------------------------- 
     97!          ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
     98!          !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
     99   sn_tem  = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' ' 
     100   sn_sal  = 'data_1m_salinity_nomask'             , -1,'vosaline',  .true.  , .true., 'yearly'   , ''       , ' ' 
    101101   ! 
    102    cn_dir       = './'     !  root directory for the location of the runoff files 
    103 / 
    104 !----------------------------------------------------------------------- 
    105 &namdta_sal    !   data : salinity                                      ("key_dtasal") 
    106 !----------------------------------------------------------------------- 
    107 !              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    108 !              !           !  (if <0  months)     !   name   !   (logical)  ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
    109    sn_sal      =  'data_1m_salinity_nomask',  -1  ,'vosaline',    .true.    , .true., 'yearly'   , ''       , ' ' 
    110    ! 
    111    cn_dir      = './'      !  root directory for the location of the runoff files 
    112 / 
    113  
     102   cn_dir        = './'     !  root directory for the location of the runoff files 
     103   ln_tsd_init   = .true.   !  Initialisation of ocean T & S with T &S input data (T) or not (F) 
     104   ln_tsd_tradmp = .true.   !  damping of ocean T & S toward T &S input data (T) or not (F) 
     105/ 
    114106!!====================================================================== 
    115107!!            ***  Surface Boundary Condition namelists  *** 
    … …  
    442434!!   namtra_adv    advection scheme 
    443435!!   namtra_ldf    lateral diffusion scheme 
    444 !!   namtra_dmp    T & S newtonian damping                              ("key_tradmp") 
     436!!   namtra_dmp    T & S newtonian damping                         
    445437!!====================================================================== 
    446438! 
    … …  
    483475/ 
    484476!----------------------------------------------------------------------- 
    485 &namtra_dmp    !   tracer: T & S newtonian damping                      ('key_tradmp') 
    486 !----------------------------------------------------------------------- 
     477&namtra_dmp    !   tracer: T & S newtonian damping                   
     478!----------------------------------------------------------------------- 
     479   ln_tradmp   =  .true.   !  add a damping termn (T) or not (F) 
    487480   nn_hdmp     =   -1      !  horizontal shape =-1, damping in Med and Red Seas only 
    488481                           !                   =XX, damping poleward of XX degrees (XX>0) 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist

    r2715 r2789  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    22!! NEMO/OPA  :  1 - run manager      (namrun) 
    3 !! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal) 
     3!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd) 
    44!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 
    55!!                                    namsbc_cpl, namsbc_cpl_co2 namtra_qsr, namsbc_rnf,  
    … …  
    5151!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate 
    5252!!   namdom       space and time domain (bathymetry, mesh, timestep) 
    53 !!   namdta_tem   data: temperature                                     ("key_dtatem") 
    54 !!   namdta_sal   data: salinity                                        ("key_dtasal") 
     53!!   namtsd       data: temperature & salinity      
    5554!!====================================================================== 
    5655! 
    … …  
    9493/ 
    9594!----------------------------------------------------------------------- 
    96 &namdta_tem    !   data : temperature                                   ("key_dtatem") 
    97 !----------------------------------------------------------------------- 
    98 !              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    99 !              !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
    100    sn_tem = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' ' 
     95&namtsd    !   data : Temperature  & Salinity                            
     96!----------------------------------------------------------------------- 
     97!          ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
     98!          !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
     99   sn_tem  = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' ' 
     100   sn_sal  = 'data_1m_salinity_nomask'             , -1,'vosaline',  .true.  , .true., 'yearly'   , ''       , ' ' 
    101101   ! 
    102    cn_dir       = './'     !  root directory for the location of the runoff files 
    103 / 
    104 !----------------------------------------------------------------------- 
    105 &namdta_sal    !   data : salinity                                      ("key_dtasal") 
    106 !----------------------------------------------------------------------- 
    107 !              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    108 !              !           !  (if <0  months)     !   name   !   (logical)  ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
    109    sn_sal      =  'data_1m_salinity_nomask',  -1  ,'vosaline',    .true.    , .true., 'yearly'   , ''       , ' ' 
    110    ! 
    111    cn_dir      = './'      !  root directory for the location of the runoff files 
    112 / 
    113  
     102   cn_dir        = './'     !  root directory for the location of the runoff files 
     103   ln_tsd_init   = .false.   !  Initialisation of ocean T & S with T &S input data (T) or not (F) 
     104   ln_tsd_tradmp = .false.   !  damping of ocean T & S toward T &S input data (T) or not (F) 
     105/ 
    114106!!====================================================================== 
    115107!!            ***  Surface Boundary Condition namelists  *** 
    … …  
    442434!!   namtra_adv    advection scheme 
    443435!!   namtra_ldf    lateral diffusion scheme 
    444 !!   namtra_dmp    T & S newtonian damping                              ("key_tradmp") 
     436!!   namtra_dmp    T & S newtonian damping                            
    445437!!====================================================================== 
    446438 
    … …  
    483475/ 
    484476!----------------------------------------------------------------------- 
    485 &namtra_dmp    !   tracer: T & S newtonian damping                      ('key_tradmp') 
    486 !----------------------------------------------------------------------- 
     477&namtra_dmp    !   tracer: T & S newtonian damping                    
     478!----------------------------------------------------------------------- 
     479   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F) 
    487480   nn_hdmp     =   -1      !  horizontal shape =-1, damping in Med and Red Seas only 
    488481                           !                   =XX, damping poleward of XX degrees (XX>0) 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/CONFIG/POMME/EXP00/namelist

    r2650 r2789  
    11!!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    22!! NEMO/OPA  :  1 - run manager      (namrun) 
    3 !! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namdta_tem, namdta_sal) 
     3!! namelists    2 - Domain           (namzgr, namzgr_sco, namdom, namtsd) 
    44!!              3 - Surface boundary (namsbc, namsbc_ana, namsbc_flx, namsbc_clio, namsbc_core 
    55!!                                    namsbc_cpl, namsbc_cpl_co2 namtra_qsr, namsbc_rnf,  
    … …  
    5151!!   namzgr_sco   s-coordinate or hybrid z-s-coordinate 
    5252!!   namdom       space and time domain (bathymetry, mesh, timestep) 
    53 !!   namdta_tem   data: temperature                                     ("key_dtatem") 
    54 !!   namdta_sal   data: salinity                                        ("key_dtasal") 
     53!!   namtsd       data: temperature & salinity          
    5554!!====================================================================== 
    5655! 
    … …  
    9493/ 
    9594!----------------------------------------------------------------------- 
    96 &namdta_tem    !   data : temperature                                   ("key_dtatem") 
    97 !----------------------------------------------------------------------- 
    98 !              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    99 !              !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
    100    sn_tem = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' ' 
     95&namtsd    !   data : Temperature  & Salinity                            
     96!----------------------------------------------------------------------- 
     97!          ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
     98!          !           !  (if <0  months)     !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
     99   sn_tem  = 'data_1m_potential_temperature_nomask', -1,'votemper',  .true.  , .true., 'yearly'   , ' '      , ' ' 
     100   sn_sal  = 'data_1m_salinity_nomask'             , -1,'vosaline',  .true.  , .true., 'yearly'   , ''       , ' ' 
    101101   ! 
    102    cn_dir       = './'     !  root directory for the location of the runoff files 
    103 / 
    104 !----------------------------------------------------------------------- 
    105 &namdta_sal    !   data : salinity                                      ("key_dtasal") 
    106 !----------------------------------------------------------------------- 
    107 !              ! file name ! frequency (hours)    ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
    108 !              !           !  (if <0  months)     !   name   !   (logical)  ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
    109    sn_sal      =  'data_1m_salinity_nomask',  -1  ,'vosaline',    .true.    , .true., 'yearly'   , ''       , ' ' 
    110    ! 
    111    cn_dir      = './'      !  root directory for the location of the runoff files 
    112 / 
    113  
     102   cn_dir        = './'     !  root directory for the location of the runoff files 
     103   ln_tsd_init   = .true.   !  Initialisation of ocean T & S with T &S input data (T) or not (F) 
     104   ln_tsd_tradmp = .false.  !  damping of ocean T & S toward T &S input data (T) or not (F) 
     105/ 
    114106!!====================================================================== 
    115107!!            ***  Surface Boundary Condition namelists  *** 
    … …  
    442434!!   namtra_adv    advection scheme 
    443435!!   namtra_ldf    lateral diffusion scheme 
    444 !!   namtra_dmp    T & S newtonian damping                              ("key_tradmp") 
     436!!   namtra_dmp    T & S newtonian damping                          
    445437!!====================================================================== 
    446438! 
    … …  
    483475/ 
    484476!----------------------------------------------------------------------- 
    485 &namtra_dmp    !   tracer: T & S newtonian damping                      ('key_tradmp') 
    486 !----------------------------------------------------------------------- 
     477&namtra_dmp    !   tracer: T & S newtonian damping                     
     478!----------------------------------------------------------------------- 
     479   ln_tradmp   =  .false.  !  add a damping termn (T) or not (F) 
    487480   nn_hdmp     =    1      !  horizontal shape =-1, damping in Med and Red Seas only 
    488481                           !                   =XX, damping poleward of XX degrees (XX>0) 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/LIM_SRC_2/limistate_2.F90

    r2528 r2789  
    7070      IF( .NOT. ln_limini ) THEN   
    7171          
    72          tfu(:,:) = tfreez( sn(:,:,1) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius] 
     72         tfu(:,:) = tfreez( tsn(:,:,1,jp_sal) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius] 
    7373 
    7474         DO jj = 1, jpj 
    7575            DO ji = 1, jpi 
    7676               !                     ! ice if sst <= t-freez + ttest 
    77                IF( tn(ji,jj,1)  - tfu(ji,jj) >= ttest ) THEN   ;   zidto = 0.e0      ! no ice 
    78                ELSE                                            ;   zidto = 1.e0      !    ice 
     77               IF( tsn(ji,jj,1,jp_tem)  - tfu(ji,jj) >= ttest ) THEN   ;   zidto = 0.e0      ! no ice 
     78               ELSE                                                    ;   zidto = 1.e0      !    ice 
    7979               ENDIF 
    8080               ! 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/LIM_SRC_3/limistate.F90

    r2777 r2789  
    9898      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 
    9999 
    100       t_bo(:,:) = tfreez( sn(:,:,1) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius] 
     100      t_bo(:,:) = tfreez( tsn(:,:,1,jp_sal) ) * tmask(:,:,1)       ! freezing/melting point of sea water [Celcius] 
    101101 
    102102      DO jj = 1, jpj                                       ! ice if sst <= t-freez + ttest 
    103103         DO ji = 1, jpi 
    104             IF( tn(ji,jj,1)  - t_bo(ji,jj) >= ttest ) THEN   ;   zidto(ji,jj) = 0.e0      ! no ice 
    105             ELSE                                             ;   zidto(ji,jj) = 1.e0      !    ice 
     104            IF( tsn(ji,jj,1,jp_tem)  - t_bo(ji,jj) >= ttest ) THEN   ;   zidto(ji,jj) = 0.e0      ! no ice 
     105            ELSE                                                     ;   zidto(ji,jj) = 1.e0      !    ice 
    106106            ENDIF 
    107107         END DO 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90

    r2715 r2789  
    3535   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,  DIMENSION(:,:) ::   spe1ur2, spe2vr2, spbtr3   !: ??? 
    3636    
    37    INTEGER :: tn_id, sn_id, tb_id, sb_id, ta_id, sa_id 
     37   INTEGER :: tsn_id,tsb_id,tsa_id 
    3838   INTEGER :: un_id, vn_id, ua_id, va_id 
    3939   INTEGER :: e1u_id, e2v_id, sshn_id, gcb_id 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r2715 r2789  
    4848      !!---------------------------------------------------------------------- 
    4949      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    50       USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2 
     50      USE wrk_nemo, ONLY: wrk_4d_1 
    5151      !! 
    52       INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     52      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    5353      REAL(wp) ::   zrhox , alpha1, alpha2, alpha3 
    5454      REAL(wp) ::   alpha4, alpha5, alpha6, alpha7 
    55       REAL(wp), POINTER, DIMENSION(:,:,:) :: zta, zsa 
     55      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztsa 
    5656      !!---------------------------------------------------------------------- 
    5757      ! 
    5858      IF( Agrif_Root() )   RETURN 
    5959 
    60       zta => wrk_3d_1 ; zsa => wrk_3d_2 
    61       IF( wrk_in_use(3, 1,2) )THEN 
     60      ztsa => wrk_4d_1  
     61      IF( wrk_in_use(4, 1) )THEN 
    6262         CALL ctl_stop('agrif_tra: requested workspace arrays unavailable.') 
    6363         RETURN 
    … …  
    6666      Agrif_SpecialValue    = 0.e0 
    6767      Agrif_UseSpecialValue = .TRUE. 
    68       zta(:,:,:) = 0.e0 
    69       zsa(:,:,:) = 0.e0 
    70  
    71       CALL Agrif_Bc_variable( zta, tn_id, procname = interptn ) 
    72       CALL Agrif_Bc_variable( zsa, sn_id, procname = interpsn ) 
     68      ztsa(:,:,:,:) = 0.e0 
     69 
     70      CALL Agrif_Bc_variable( ztsa, tsn_id, procname=interptsn ) 
    7371      Agrif_UseSpecialValue = .FALSE. 
    7472 
    … …  
    8785      IF( nbondi == 1 .OR. nbondi == 2 ) THEN 
    8886 
    89          ta(nlci,:,:) = alpha1 * zta(nlci,:,:) + alpha2 * zta(nlci-1,:,:) 
    90          sa(nlci,:,:) = alpha1 * zsa(nlci,:,:) + alpha2 * zsa(nlci-1,:,:) 
    91  
    92          DO jk = 1, jpkm1 
    93             DO jj = 1, jpj 
    94                IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
    95                   ta(nlci-1,jj,jk) = ta(nlci,jj,jk) * tmask(nlci-1,jj,jk) 
    96                   sa(nlci-1,jj,jk) = sa(nlci,jj,jk) * tmask(nlci-1,jj,jk) 
    97                ELSE 
    98                   ta(nlci-1,jj,jk)=(alpha4*ta(nlci,jj,jk)+alpha3*ta(nlci-2,jj,jk))*tmask(nlci-1,jj,jk) 
    99                   sa(nlci-1,jj,jk)=(alpha4*sa(nlci,jj,jk)+alpha3*sa(nlci-2,jj,jk))*tmask(nlci-1,jj,jk) 
    100                   IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
    101                      ta(nlci-1,jj,jk)=( alpha6*ta(nlci-2,jj,jk)+alpha5*ta(nlci,jj,jk)  & 
    102                         &             + alpha7*ta(nlci-3,jj,jk) ) * tmask(nlci-1,jj,jk) 
    103                      sa(nlci-1,jj,jk)=( alpha6*sa(nlci-2,jj,jk)+alpha5*sa(nlci,jj,jk)  & 
    104                         &             + alpha7*sa(nlci-3,jj,jk) ) * tmask(nlci-1,jj,jk) 
     87         DO jn = 1, jpts 
     88            tsa(nlci,:,:,jn) = alpha1 * ztsa(nlci,:,:,jn) + alpha2 * ztsa(nlci-1,:,:,jn) 
     89            DO jk = 1, jpkm1 
     90               DO jj = 1, jpj 
     91                  IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 
     92                     tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 
     93                  ELSE 
     94                     tsa(nlci-1,jj,jk,jn)=(alpha4*tsa(nlci,jj,jk,jn)+alpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 
     95                     IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 
     96                        tsa(nlci-1,jj,jk,jn)=( alpha6*tsa(nlci-2,jj,jk,jn)+alpha5*tsa(nlci,jj,jk,jn)  & 
     97                           &                 + alpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 
     98                     ENDIF 
    10599                  ENDIF 
    106                ENDIF 
    107             END DO 
    108          END DO 
     100               END DO 
     101            END DO 
     102         ENDDO 
    109103      ENDIF 
    110104 
    111105      IF( nbondj == 1 .OR. nbondj == 2 ) THEN 
    112106 
    113          ta(:,nlcj,:) = alpha1 * zta(:,nlcj,:) + alpha2 * zta(:,nlcj-1,:) 
    114          sa(:,nlcj,:) = alpha1 * zsa(:,nlcj,:) + alpha2 * zsa(:,nlcj-1,:) 
    115  
    116          DO jk = 1, jpkm1 
    117             DO ji = 1, jpi 
    118                IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
    119                   ta(ji,nlcj-1,jk) = ta(ji,nlcj,jk) * tmask(ji,nlcj-1,jk) 
    120                   sa(ji,nlcj-1,jk) = sa(ji,nlcj,jk) * tmask(ji,nlcj-1,jk) 
    121                ELSE 
    122                   ta(ji,nlcj-1,jk)=(alpha4*ta(ji,nlcj,jk)+alpha3*ta(ji,nlcj-2,jk))*tmask(ji,nlcj-1,jk)         
    123                   sa(ji,nlcj-1,jk)=(alpha4*sa(ji,nlcj,jk)+alpha3*sa(ji,nlcj-2,jk))*tmask(ji,nlcj-1,jk) 
    124                   IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
    125                      ta(ji,nlcj-1,jk)=( alpha6*ta(ji,nlcj-2,jk)+alpha5*ta(ji,nlcj,jk)  & 
    126                         &             + alpha7*ta(ji,nlcj-3,jk) ) * tmask(ji,nlcj-1,jk) 
    127                      sa(ji,nlcj-1,jk)=( alpha6*sa(ji,nlcj-2,jk)+alpha5*sa(ji,nlcj,jk)  & 
    128                         &             + alpha7*sa(ji,nlcj-3,jk))*tmask(ji,nlcj-1,jk) 
     107         DO jn = 1, jpts 
     108            tsa(:,nlcj,:,jn) = alpha1 * ztsa(:,nlcj,:,jn) + alpha2 * ztsa(:,nlcj-1,:,jn) 
     109            DO jk = 1, jpkm1 
     110               DO ji = 1, jpi 
     111                  IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 
     112                     tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 
     113                  ELSE 
     114                     tsa(ji,nlcj-1,jk,jn)=(alpha4*tsa(ji,nlcj,jk,jn)+alpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)         
     115                     IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 
     116                        tsa(ji,nlcj-1,jk,jn)=( alpha6*tsa(ji,nlcj-2,jk,jn)+alpha5*tsa(ji,nlcj,jk,jn)  & 
     117                           &                 + alpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 
     118                     ENDIF 
    129119                  ENDIF 
    130                ENDIF 
    131             END DO 
    132          END DO 
     120               END DO 
     121            END DO 
     122         ENDDO  
    133123      ENDIF 
    134124 
    135125      IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
    136          ta(1,:,:) = alpha1 * zta(1,:,:) + alpha2 * zta(2,:,:) 
    137          sa(1,:,:) = alpha1 * zsa(1,:,:) + alpha2 * zsa(2,:,:)       
    138          DO jk = 1, jpkm1 
    139             DO jj = 1, jpj 
    140                IF( umask(2,jj,jk) == 0.e0 ) THEN 
    141                   ta(2,jj,jk) = ta(1,jj,jk) * tmask(2,jj,jk) 
    142                   sa(2,jj,jk) = sa(1,jj,jk) * tmask(2,jj,jk) 
    143                ELSE 
    144                   ta(2,jj,jk)=(alpha4*ta(1,jj,jk)+alpha3*ta(3,jj,jk))*tmask(2,jj,jk)         
    145                   sa(2,jj,jk)=(alpha4*sa(1,jj,jk)+alpha3*sa(3,jj,jk))*tmask(2,jj,jk) 
    146                   IF( un(2,jj,jk) < 0.e0 ) THEN 
    147                      ta(2,jj,jk)=(alpha6*ta(3,jj,jk)+alpha5*ta(1,jj,jk)+alpha7*ta(4,jj,jk))*tmask(2,jj,jk) 
    148                      sa(2,jj,jk)=(alpha6*sa(3,jj,jk)+alpha5*sa(1,jj,jk)+alpha7*sa(4,jj,jk))*tmask(2,jj,jk) 
     126         DO jn = 1, jpts 
     127            tsa(1,:,:,jn) = alpha1 * ztsa(1,:,:,jn) + alpha2 * ztsa(2,:,:,jn) 
     128            DO jk = 1, jpkm1 
     129               DO jj = 1, jpj 
     130                  IF( umask(2,jj,jk) == 0.e0 ) THEN 
     131                     tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 
     132                  ELSE 
     133                     tsa(2,jj,jk,jn)=(alpha4*tsa(1,jj,jk,jn)+alpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)         
     134                     IF( un(2,jj,jk) < 0.e0 ) THEN 
     135                        tsa(2,jj,jk,jn)=(alpha6*tsa(3,jj,jk,jn)+alpha5*tsa(1,jj,jk,jn)+alpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk) 
     136                     ENDIF 
    149137                  ENDIF 
    150                ENDIF 
     138               END DO 
    151139            END DO 
    152140         END DO 
    … …  
    154142 
    155143      IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
    156          ta(:,1,:) = alpha1 * zta(:,1,:) + alpha2 * zta(:,2,:) 
    157          sa(:,1,:) = alpha1 * zsa(:,1,:) + alpha2 * zsa(:,2,:) 
    158          DO jk=1,jpk       
    159             DO ji=1,jpi 
    160                IF( vmask(ji,2,jk) == 0.e0 ) THEN 
    161                   ta(ji,2,jk)=ta(ji,1,jk) * tmask(ji,2,jk) 
    162                   sa(ji,2,jk)=sa(ji,1,jk) * tmask(ji,2,jk) 
    163                ELSE 
    164                   ta(ji,2,jk)=(alpha4*ta(ji,1,jk)+alpha3*ta(ji,3,jk))*tmask(ji,2,jk) 
    165                   sa(ji,2,jk)=(alpha4*sa(ji,1,jk)+alpha3*sa(ji,3,jk))*tmask(ji,2,jk)  
    166                   IF( vn(ji,2,jk) < 0.e0 ) THEN 
    167                      ta(ji,2,jk)=(alpha6*ta(ji,3,jk)+alpha5*ta(ji,1,jk)+alpha7*ta(ji,4,jk))*tmask(ji,2,jk) 
    168                      sa(ji,2,jk)=(alpha6*sa(ji,3,jk)+alpha5*sa(ji,1,jk)+alpha7*sa(ji,4,jk))*tmask(ji,2,jk) 
     144         DO jn = 1, jpts 
     145            tsa(:,1,:,jn) = alpha1 * ztsa(:,1,:,jn) + alpha2 * ztsa(:,2,:,jn) 
     146            DO jk=1,jpk       
     147               DO ji=1,jpi 
     148                  IF( vmask(ji,2,jk) == 0.e0 ) THEN 
     149                     tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 
     150                  ELSE 
     151                     tsa(ji,2,jk,jn)=(alpha4*tsa(ji,1,jk,jn)+alpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 
     152                     IF( vn(ji,2,jk) < 0.e0 ) THEN 
     153                        tsa(ji,2,jk,jn)=(alpha6*tsa(ji,3,jk,jn)+alpha5*tsa(ji,1,jk,jn)+alpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk) 
     154                     ENDIF 
    169155                  ENDIF 
    170                ENDIF 
    171             END DO 
    172          END DO 
     156               END DO 
     157            END DO 
     158         ENDDO 
    173159      ENDIF 
    174160      ! 
    175       IF( wrk_not_released(3, 1,2) ) THEN 
     161      IF( wrk_not_released(4, 1) ) THEN 
    176162         CALL ctl_stop('agrif_tra: failed to release workspace arrays.') 
    177163      ENDIF 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90

    r2715 r2789  
    1212   PRIVATE 
    1313 
    14    PUBLIC Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptn, interpsn, interpun, interpvn 
     14   PUBLIC Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptsn, interpun, interpvn 
    1515 
    1616   !!---------------------------------------------------------------------- 
    … …  
    2828#include "domzgr_substitute.h90" 
    2929      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    30       USE wrk_nemo, ONLY: wrk_2d_1 
    31       USE wrk_nemo, ONLY: wrk_3d_1, wrk_3d_2 
    32       USE wrk_nemo, ONLY: wrk_3d_3, wrk_3d_4 
    33       USE wrk_nemo, ONLY: wrk_3d_7, wrk_3d_6 
    34       USE wrk_nemo, ONLY: wrk_3d_8 
     30      USE wrk_nemo, ONLY: wrk_2d_1, wrk_2d_2, wrk_2d_3 
     31      USE wrk_nemo, ONLY: wrk_4d_1, wrk_4d_2 
    3532      !! 
    36       INTEGER :: ji,jj,jk 
     33      INTEGER :: ji,jj,jk,jn 
    3734      INTEGER :: spongearea 
    3835      REAL(wp) :: timecoeff 
    39       REAL(wp) :: zta, zsa, zabe1, zabe2, zbtr 
    40       REAL(wp), POINTER, DIMENSION(:,:) :: localviscsponge 
    41       REAL(wp), POINTER, DIMENSION(:,:,:) :: tbdiff, sbdiff 
    42       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztu, zsu, ztv, zsv 
    43       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 
     36      REAL(wp) :: ztsa, zabe1, zabe2, zbtr 
     37      REAL(wp), POINTER, DIMENSION(:,:    ) :: localviscsponge 
     38      REAL(wp), POINTER, DIMENSION(:,:    ) :: ztu, ztv 
     39      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 
     40      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: tsbdiff 
    4441 
    4542#if defined SPONGE 
    4643      localviscsponge => wrk_2d_1 
    47       tbdiff => wrk_3d_1 ;sbdiff => wrk_3d_2 
    48       ztu => wrk_3d_3 ; zsu => wrk_3d_4 
    49       ztv => wrk_3d_7 ; zsv => wrk_3d_6 
    50       ztab => wrk_3d_8 
     44      ztu             => wrk_2d_2 
     45      ztv             => wrk_2d_3 
     46      ztab            => wrk_4d_1 
     47      tsbdiff         => wrk_4d_2 
    5148 
    5249      timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 
    … …  
    5552      Agrif_UseSpecialValue = .TRUE. 
    5653      ztab = 0.e0 
    57       CALL Agrif_Bc_Variable(ztab, ta_id,calledweight=timecoeff,procname=interptn) 
     54      CALL Agrif_Bc_Variable(ztab, tsa_id,calledweight=timecoeff,procname=interptsn) 
    5855      Agrif_UseSpecialValue = .FALSE. 
    5956 
    60       tbdiff(:,:,:) = tb(:,:,:) - ztab(:,:,:) 
    61  
    62       ztab = 0.e0 
    63       Agrif_SpecialValue=0. 
    64       Agrif_UseSpecialValue = .TRUE. 
    65       CALL Agrif_Bc_Variable(ztab, sa_id,calledweight=timecoeff,procname=interpsn) 
    66       Agrif_UseSpecialValue = .FALSE. 
    67  
    68       sbdiff(:,:,:) = sb(:,:,:) - ztab(:,:,:) 
     57      tsbdiff(:,:,:,:) = tsb(:,:,:,:) - ztab(:,:,:,:) 
    6958 
    7059      spongearea = 2 + 2 * Agrif_irhox() 
    … …  
    137126      ENDIF 
    138127 
    139       DO jk = 1, jpkm1 
    140          DO jj = 1, jpjm1 
    141             DO ji = 1, jpim1 
    142                zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk) 
    143                zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk) 
    144                ztu(ji,jj,jk) = zabe1 * ( tbdiff(ji+1,jj  ,jk) - tbdiff(ji,jj,jk) ) 
    145                zsu(ji,jj,jk) = zabe1 * ( sbdiff(ji+1,jj  ,jk) - sbdiff(ji,jj,jk) ) 
    146                ztv(ji,jj,jk) = zabe2 * ( tbdiff(ji  ,jj+1,jk) - tbdiff(ji,jj,jk) ) 
    147                zsv(ji,jj,jk) = zabe2 * ( sbdiff(ji  ,jj+1,jk) - sbdiff(ji,jj,jk) ) 
     128      DO jn = 1, jpts 
     129         DO jk = 1, jpkm1 
     130            ! 
     131            DO jj = 1, jpjm1 
     132               DO ji = 1, jpim1 
     133                  zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk) 
     134                  zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk) 
     135                  ztu(ji,jj) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
     136                  ztv(ji,jj) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
     137               ENDDO 
    148138            ENDDO 
    149          ENDDO 
    150  
    151          DO jj = 2,jpjm1 
    152             DO ji = 2,jpim1 
    153                zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 
    154                ! horizontal diffusive trends 
    155                zta = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   & 
    156                   &          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) 
    157                zsa = zbtr * (  zsu(ji,jj,jk) - zsu(ji-1,jj,jk)   & 
    158                   &          + zsv(ji,jj,jk) - zsv(ji,jj-1,jk)  ) 
    159                ! add it to the general tracer trends 
    160                ta(ji,jj,jk) = (ta(ji,jj,jk) + zta) 
    161                sa(ji,jj,jk) = (sa(ji,jj,jk) + zsa) 
     139 
     140            DO jj = 2, jpjm1 
     141               DO ji = 2, jpim1 
     142                  zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk) 
     143                  ! horizontal diffusive trends 
     144                  ztsa = zbtr * (  ztu(ji,jj) - ztu(ji-1,jj  )   & 
     145                  &              + ztv(ji,jj) - ztv(ji  ,jj-1)  ) 
     146                  ! add it to the general tracer trends 
     147                  tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa 
     148               END DO 
    162149            END DO 
    163          END DO 
    164  
     150            ! 
     151         ENDDO 
    165152      ENDDO 
    166153 
    … …  
    345332   END SUBROUTINE Agrif_Sponge_dyn 
    346333 
    347    SUBROUTINE interptn(tabres,i1,i2,j1,j2,k1,k2) 
    348       !!--------------------------------------------- 
    349       !!   *** ROUTINE interptn *** 
     334   SUBROUTINE interptsn(tabres,i1,i2,j1,j2,k1,k2,n1,n2) 
     335      !!--------------------------------------------- 
     336      !!   *** ROUTINE interptsn *** 
    350337      !!--------------------------------------------- 
    351338#  include "domzgr_substitute.h90"        
    352339       
    353       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    354       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    355  
    356       tabres(i1:i2,j1:j2,k1:k2) = tn(i1:i2,j1:j2,k1:k2) 
    357  
    358    END SUBROUTINE interptn 
    359  
    360    SUBROUTINE interpsn(tabres,i1,i2,j1,j2,k1,k2) 
    361       !!--------------------------------------------- 
    362       !!   *** ROUTINE interpsn *** 
    363       !!--------------------------------------------- 
    364 #  include "domzgr_substitute.h90"        
    365        
    366       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    367       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    368  
    369       tabres(i1:i2,j1:j2,k1:k2) = sn(i1:i2,j1:j2,k1:k2) 
    370  
    371    END SUBROUTINE interpsn 
     340      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
     341      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
     342 
     343      tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 
     344 
     345   END SUBROUTINE interptsn 
    372346 
    373347   SUBROUTINE interpun(tabres,i1,i2,j1,j2,k1,k2) 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r2715 r2789  
    3030      !!--------------------------------------------- 
    3131      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    32       USE wrk_nemo, ONLY: wrk_3d_1 
     32      USE wrk_nemo, ONLY: wrk_4d_1 
    3333      !! 
    3434      INTEGER, INTENT(in) :: kt 
    35       REAL(wp), POINTER, DIMENSION(:,:,:) :: ztab 
     35      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztab 
    3636 
    3737        
    3838      IF((Agrif_NbStepint() .NE. (Agrif_irhot()-1)).AND.(kt /= 0)) RETURN 
    3939#if defined TWO_WAY 
    40       ztab => wrk_3d_1 
    41       IF( wrk_in_use(3, 1) ) THEN 
     40      IF( wrk_in_use(4, 1) ) THEN 
    4241         CALL ctl_stop('agrif_update_tra: ERROR: requested workspace arrays unavailable') 
    4342         RETURN 
    4443      END IF 
     44      ztab => wrk_4d_1 
    4545 
    4646      Agrif_UseSpecialValueInUpdate = .TRUE. 
    … …  
    4848 
    4949      IF (MOD(nbcline,nbclineupdate) == 0) THEN 
    50          CALL Agrif_Update_Variable(ztab,tn_id, procname=updateT) 
    51          CALL Agrif_Update_Variable(ztab,sn_id, procname=updateS) 
    52       ELSE 
    53          CALL Agrif_Update_Variable(ztab,tn_id,locupdate=(/0,2/), procname=updateT) 
    54          CALL Agrif_Update_Variable(ztab,sn_id,locupdate=(/0,2/), procname=updateS) 
     50         CALL Agrif_Update_Variable(ztab,tsn_id, procname=updateTS) 
     51      ELSE 
     52         CALL Agrif_Update_Variable(ztab,tsn_id,locupdate=(/0,2/), procname=updateTS) 
    5553      ENDIF 
    5654 
    5755      Agrif_UseSpecialValueInUpdate = .FALSE. 
    5856 
    59       IF( wrk_not_released(3, 1) ) THEN 
     57      IF( wrk_not_released(4, 1) ) THEN 
    6058         CALL ctl_stop('Agrif_Update_Tra: ERROR: failed to release workspace arrays') 
    6159      END IF 
    … …  
    124122   END SUBROUTINE recompute_diags 
    125123 
    126    SUBROUTINE updateT( tabres, i1, i2, j1, j2, k1, k2, before ) 
     124   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    127125      !!--------------------------------------------- 
    128126      !!           *** ROUTINE updateT *** 
    … …  
    130128#  include "domzgr_substitute.h90" 
    131129 
    132       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    133       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
     130      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
     131      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
    134132      LOGICAL, iNTENT(in) :: before 
    135133 
    136       INTEGER :: ji,jj,jk 
    137  
    138       IF (before) THEN 
    139          DO jk=k1,k2 
    140             DO jj=j1,j2 
    141                DO ji=i1,i2 
    142                   tabres(ji,jj,jk) = tn(ji,jj,jk) 
    143                END DO 
    144             END DO 
    145          END DO 
    146       ELSE 
    147          DO jk=k1,k2 
    148             DO jj=j1,j2 
    149                DO ji=i1,i2 
    150                   IF( tabres(ji,jj,jk) .NE. 0. ) THEN 
    151                      tn(ji,jj,jk) = tabres(ji,jj,jk) * tmask(ji,jj,jk) 
    152                   ENDIF 
    153                END DO 
    154             END DO 
    155          END DO 
    156       ENDIF 
    157  
    158    END SUBROUTINE updateT 
    159  
    160    SUBROUTINE updateS( tabres, i1, i2, j1, j2, k1, k2, before ) 
    161       !!--------------------------------------------- 
    162       !!           *** ROUTINE updateS *** 
    163       !!--------------------------------------------- 
    164 #  include "domzgr_substitute.h90" 
    165  
    166       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    167       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    168       LOGICAL, iNTENT(in) :: before 
    169  
    170       INTEGER :: ji,jj,jk 
    171  
    172       IF (before) THEN 
    173          DO jk=k1,k2 
    174             DO jj=j1,j2 
    175                DO ji=i1,i2 
    176                   tabres(ji,jj,jk) = sn(ji,jj,jk) 
    177                END DO 
    178             END DO 
    179          END DO 
    180       ELSE 
    181          DO jk=k1,k2 
    182             DO jj=j1,j2 
    183                DO ji=i1,i2 
    184                   IF (tabres(ji,jj,jk).NE.0.) THEN 
    185                      sn(ji,jj,jk) = tabres(ji,jj,jk) * tmask(ji,jj,jk) 
    186                   ENDIF 
    187                END DO 
    188             END DO 
    189          END DO 
    190       ENDIF 
    191  
    192    END SUBROUTINE updateS 
     134      INTEGER :: ji,jj,jk,jn 
     135 
     136      IF (before) THEN 
     137         DO jn = n1,n2 
     138            DO jk=k1,k2 
     139               DO jj=j1,j2 
     140                  DO ji=i1,i2 
     141                     tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn) 
     142                  END DO 
     143               END DO 
     144            END DO 
     145         END DO 
     146      ELSE 
     147         DO jn = n1,n2 
     148            DO jk=k1,k2 
     149               DO jj=j1,j2 
     150                  DO ji=i1,i2 
     151                     IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN  
     152                         tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) * tmask(ji,jj,jk) 
     153                     END IF 
     154                  END DO 
     155               END DO 
     156            END DO 
     157         END DO 
     158      ENDIF 
     159 
     160   END SUBROUTINE updateTS 
    193161 
    194162   SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, before ) 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r2727 r2789  
    5454      USE dom_oce 
    5555      USE nemogcm 
    56 #if defined key_tradmp   ||   defined key_esopa 
    5756      USE tradmp 
    58 #endif 
    5957#if defined key_obc   ||   defined key_esopa 
    6058      USE obc_par 
    … …  
    7169 
    7270      ! Specific fine grid Initializations 
    73 #if defined key_tradmp || defined key_esopa 
    7471      ! no tracer damping on fine grids 
    75       lk_tradmp = .FALSE. 
    76 #endif 
     72      ln_tradmp = .FALSE. 
    7773#if defined key_obc || defined key_esopa 
    7874      ! no open boundary on fine grids 
    … …  
    110106      IMPLICIT NONE 
    111107      ! 
    112       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tabtemp 
     108      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp 
     109      REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE :: tabuvtemp 
    113110      LOGICAL :: check_namelist 
    114111      !!---------------------------------------------------------------------- 
    115112 
    116       ALLOCATE( tabtemp(jpi,jpj,jpk) ) 
    117        
    118        
     113      ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) ) 
     114      ALLOCATE( tabuvtemp(jpi, jpj, jpk)       ) 
     115 
     116 
    119117      ! 1. Declaration of the type of variable which have to be interpolated 
    120118      !--------------------------------------------------------------------- 
    … …  
    125123      Agrif_SpecialValue=0. 
    126124      Agrif_UseSpecialValue = .TRUE. 
    127       Call Agrif_Bc_variable(tabtemp,tn_id,calledweight=1.,procname=interptn) 
    128      
    129       Call Agrif_Bc_variable(tabtemp,sn_id,calledweight=1.,procname=interpsn) 
    130       Call Agrif_Bc_variable(tabtemp,un_id,calledweight=1.,procname=interpu) 
    131       Call Agrif_Bc_variable(tabtemp,vn_id,calledweight=1.,procname=interpv) 
    132  
    133       Call Agrif_Bc_variable(tabtemp,ta_id,calledweight=1.,procname=interptn) 
    134       Call Agrif_Bc_variable(tabtemp,sa_id,calledweight=1.,procname=interpsn) 
    135  
    136       Call Agrif_Bc_variable(tabtemp,ua_id,calledweight=1.,procname=interpun) 
    137       Call Agrif_Bc_variable(tabtemp,va_id,calledweight=1.,procname=interpvn) 
     125      Call Agrif_Bc_variable(tabtstemp,tsn_id,calledweight=1.,procname=interptsn) 
     126      Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn) 
     127 
     128      Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu) 
     129      Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv) 
     130      Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun) 
     131      Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn) 
    138132      Agrif_UseSpecialValue = .FALSE. 
    139133 
    … …  
    192186      nbcline = 0 
    193187      ! 
    194       DEALLOCATE(tabtemp) 
     188      DEALLOCATE(tabtstemp) 
     189      DEALLOCATE(tabuvtemp) 
    195190      ! 
    196191   END SUBROUTINE Agrif_InitValues_cont 
    … …  
    204199      !!---------------------------------------------------------------------- 
    205200      USE agrif_util 
     201      USE par_oce       !   ONLY : jpts 
    206202      USE oce 
    207203      IMPLICIT NONE 
    … …  
    210206      ! 1. Declaration of the type of variable which have to be interpolated 
    211207      !--------------------------------------------------------------------- 
    212       CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),tn_id) 
    213       CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sn_id) 
    214       CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),tb_id) 
    215       CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sb_id) 
    216       CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ta_id) 
    217       CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),sa_id) 
    218           
     208      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
     209      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsa_id) 
     210      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsb_id) 
     211 
    219212      CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id) 
    220213      CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id) 
    … …  
    230223      ! 2. Type of interpolation 
    231224      !------------------------- 
    232       CALL Agrif_Set_bcinterp(tn_id,interp=AGRIF_linear) 
    233       CALL Agrif_Set_bcinterp(sn_id,interp=AGRIF_linear) 
    234       CALL Agrif_Set_bcinterp(ta_id,interp=AGRIF_linear) 
    235       CALL Agrif_Set_bcinterp(sa_id,interp=AGRIF_linear) 
     225      CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
     226      CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear) 
    236227    
    237228      Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    … …  
    252243      Call Agrif_Set_bc(e2v_id,(/0,0/)) 
    253244 
    254       Call Agrif_Set_bc(tn_id,(/0,1/)) 
    255       Call Agrif_Set_bc(sn_id,(/0,1/)) 
    256  
    257       Call Agrif_Set_bc(ta_id,(/-3*Agrif_irhox(),0/)) 
    258       Call Agrif_Set_bc(sa_id,(/-3*Agrif_irhox(),0/)) 
     245      Call Agrif_Set_bc(tsn_id,(/0,1/)) 
     246      Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/)) 
    259247 
    260248      Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/)) 
    … …  
    263251      ! 5. Update type 
    264252      !---------------  
    265       Call Agrif_Set_Updatetype(tn_id, update = AGRIF_Update_Average) 
    266       Call Agrif_Set_Updatetype(sn_id, update = AGRIF_Update_Average) 
    267  
    268       Call Agrif_Set_Updatetype(tb_id, update = AGRIF_Update_Average) 
    269       Call Agrif_Set_Updatetype(sb_id, update = AGRIF_Update_Average) 
     253      Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
     254      Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average) 
    270255 
    271256      Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
    … …  
    395380      ! 1. Declaration of the type of variable which have to be interpolated 
    396381      !--------------------------------------------------------------------- 
    397       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),  & 
    398       &                           (/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
    399       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),  & 
    400       &                           (/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id) 
    401       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0,jptra/),(/'x','y','N','N'/),  & 
    402       &                           (/1,1,1,1/),(/jpi,jpj,jpk/),tra_id) 
    403              
     382      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
     383      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id) 
     384      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),tra_id) 
    404385#  if defined key_offline 
    405386      CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/ASM/asmtrj.F90

    r2399 r2789  
    105105            ! 
    106106            !                                      ! Write the information 
    107             CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate   ) 
    108             CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un      ) 
    109             CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn      ) 
    110             CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tn      ) 
    111             CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , sn      ) 
    112             CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn    ) 
    113 #if defined key_zdftke 
    114             CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en      ) 
    115 #endif 
    116             CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx     ) 
     107            CALL iom_rstput( kt, nitbkg_r, inum, 'rdastp' , zdate             ) 
     108            CALL iom_rstput( kt, nitbkg_r, inum, 'un'     , un                ) 
     109            CALL iom_rstput( kt, nitbkg_r, inum, 'vn'     , vn                ) 
     110            CALL iom_rstput( kt, nitbkg_r, inum, 'tn'     , tsn(:,:,:,jp_tem) ) 
     111            CALL iom_rstput( kt, nitbkg_r, inum, 'sn'     , tsn(:,:,:,jp_sal) ) 
     112            CALL iom_rstput( kt, nitbkg_r, inum, 'sshn'   , sshn              ) 
     113#if defined key_zdftke 
     114            CALL iom_rstput( kt, nitbkg_r, inum, 'en'     , en                ) 
     115#endif 
     116            CALL iom_rstput( kt, nitbkg_r, inum, 'gcx'    , gcx               ) 
    117117            ! 
    118118            CALL iom_close( inum ) 
    … …  
    143143            ! 
    144144            !                                      ! Write the information 
    145             CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate   ) 
    146             CALL iom_rstput( kt, nitdin_r, inum, 'un'     , un      ) 
    147             CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vn      ) 
    148             CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , tn      ) 
    149             CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , sn      ) 
    150             CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn    ) 
     145            CALL iom_rstput( kt, nitdin_r, inum, 'rdastp' , zdate             ) 
     146            CALL iom_rstput( kt, nitdin_r, inum, 'un'     , un                ) 
     147            CALL iom_rstput( kt, nitdin_r, inum, 'vn'     , vn                ) 
     148            CALL iom_rstput( kt, nitdin_r, inum, 'tn'     , tsn(:,:,:,jp_tem) ) 
     149            CALL iom_rstput( kt, nitdin_r, inum, 'sn'     , tsn(:,:,:,jp_sal) ) 
     150            CALL iom_rstput( kt, nitdin_r, inum, 'sshn'   , sshn              ) 
    151151            ! 
    152152            CALL iom_close( inum ) 
    … …  
    216216         CALL iom_rstput( it, it, inum, 'un'    , un     ) 
    217217         CALL iom_rstput( it, it, inum, 'vn'    , vn     ) 
    218          CALL iom_rstput( it, it, inum, 'tn'    , tn    ) 
    219          CALL iom_rstput( it, it, inum, 'sn'    , sn    ) 
     218         CALL iom_rstput( it, it, inum, 'tn'    , tsn(:,:,:,jp_tem) ) 
     219         CALL iom_rstput( it, it, inum, 'sn'    , tsn(:,:,:,jp_sal) ) 
    220220         CALL iom_rstput( it, it, inum, 'avmu'  , avmu   ) 
    221221         CALL iom_rstput( it, it, inum, 'avmv'  , avmv   ) 
    … …  
    230230         CALL iom_rstput( it, it, inum, 'avs'   , avs    ) 
    231231#endif 
    232          CALL iom_rstput( it, it, inum, 'ta'    , ta    ) 
    233          CALL iom_rstput( it, it, inum, 'sa'    , sa    ) 
    234          CALL iom_rstput( it, it, inum, 'tb'    , tb    ) 
    235          CALL iom_rstput( it, it, inum, 'sb'    , sb    ) 
    236 #if defined key_tradmp 
    237          CALL iom_rstput( it, it, inum, 'strdmp', strdmp ) 
    238          CALL iom_rstput( it, it, inum, 'hmlp'  , hmlp   ) 
    239 #endif 
     232         CALL iom_rstput( it, it, inum, 'ta'    , tsa(:,:,:,jp_tem) ) 
     233         CALL iom_rstput( it, it, inum, 'sa'    , tsa(:,:,:,jp_sal) ) 
     234         CALL iom_rstput( it, it, inum, 'tb'    , tsb(:,:,:,jp_tem) ) 
     235         CALL iom_rstput( it, it, inum, 'sb'    , tsb(:,:,:,jp_sal) ) 
     236         IF( ln_tradmp ) THEN 
     237            CALL iom_rstput( it, it, inum, 'strdmp', strdmp ) 
     238            CALL iom_rstput( it, it, inum, 'hmlp'  , hmlp   ) 
     239         END IF 
    240240         CALL iom_rstput( it, it, inum, 'aeiu'  , aeiu   ) 
    241241         CALL iom_rstput( it, it, inum, 'aeiv'  , aeiv   ) 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r2715 r2789  
    332332                  ij = nbj(ib,igrd) 
    333333                  DO ik = 1, jpkm1 
    334                      tbdy(ib,ik) = tn(ii,ij,ik) 
    335                      sbdy(ib,ik) = sn(ii,ij,ik) 
     334                     tbdy(ib,ik) = tsn(ii,ij,ik,jp_tem) 
     335                     sbdy(ib,ik) = tsn(ii,ij,ik,jp_sal) 
    336336                  END DO 
    337337               END DO 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90

    r2528 r2789  
    6161               ij = nbj(ib,igrd) 
    6262               zwgt = nbw(ib,igrd) 
    63                ta(ii,ij,ik) = ( ta(ii,ij,ik) * (1.-zwgt) + tbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)          
    64                sa(ii,ij,ik) = ( sa(ii,ij,ik) * (1.-zwgt) + sbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik) 
     63               tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) * (1.-zwgt) + tbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)          
     64               tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) * (1.-zwgt) + sbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik) 
    6565            END DO 
    6666         END DO  
    67          ! 
    68          CALL lbc_lnk( ta, 'T', 1. )   ; CALL lbc_lnk( sa, 'T', 1. )    ! Boundary points should be updated 
     67         !                                              ! Boundary points should be updated 
     68         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )      
     69         CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )     
    6970         ! 
    7071      ENDIF ! ln_tra_frs 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90

    r2409 r2789  
    6464      ! Update data, open boundaries, surface boundary condition (including sea-ice) 
    6565      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    66       IF( lk_dtatem  )   CALL dta_tem( kstp )         ! update 3D temperature data 
    67       IF( lk_dtasal  )   CALL dta_sal( kstp )         ! update 3D salinity data 
    6866                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice) 
    6967 
    … …  
    127125      IF( ln_zdfnpc      )   CALL tra_npc    ( kstp )        ! applied non penetrative convective adjustment on (t,s) 
    128126                             CALL eos( tsb, rhd, rhop )      ! now (swap=before) in situ density for dynhpg module 
    129                              CALL tra_unswap                 ! udate T & S 3D arrays  (to be suppressed) 
    130127 
    131128      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DIA/diaar5.F90

    r2715 r2789  
    9494      CALL iom_put( 'sshtot', zvolssh / area_tot ) 
    9595 
    96       !                                         ! thermosteric ssh 
    97       ztsn(:,:,:,jp_tem) = tn (:,:,:) 
     96      !                      
     97      ztsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem)                    ! thermosteric ssh 
    9898      ztsn(:,:,:,jp_sal) = sn0(:,:,:) 
    9999      CALL eos( ztsn, zrhd )                       ! now in situ density using initial salinity 
    … …  
    138138            DO ji = 1, jpi 
    139139               zztmp = area(ji,jj) * fse3t(ji,jj,jk) 
    140                ztemp = ztemp + zztmp * tn(ji,jj,jk) 
    141                zsal  = zsal  + zztmp * sn(ji,jj,jk) 
     140               ztemp = ztemp + zztmp * tsn(ji,jj,jk,jp_tem) 
     141               zsal  = zsal  + zztmp * tsn(ji,jj,jk,jp_sal) 
    142142            END DO 
    143143         END DO 
    144144      END DO 
    145145      IF( .NOT.lk_vvl ) THEN 
    146          ztemp = ztemp + SUM( zarea_ssh(:,:) * tn(:,:,1) ) 
    147          zsal  = zsal  + SUM( zarea_ssh(:,:) * sn(:,:,1) ) 
     146         ztemp = ztemp + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_tem) ) 
     147         zsal  = zsal  + SUM( zarea_ssh(:,:) * tsn(:,:,1,jp_sal) ) 
    148148      ENDIF 
    149149      IF( lk_mpp ) THEN   

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DIA/diafwb.F90

    r2528 r2789  
    8080               DO ji = fs_2, fs_jpim1   ! vector opt. 
    8181                  zwei  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    82                   a_salb = a_salb + ( sb(ji,jj,jk) - zsm0 ) * zwei 
     82                  a_salb = a_salb + ( tsb(ji,jj,jk,jp_sal) - zsm0 ) * zwei 
    8383               END DO 
    8484            END DO 
    … …  
    106106               DO ji = fs_2, fs_jpim1   ! vector opt. 
    107107                  zwei  = e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj) 
    108                   a_saln = a_saln + ( sn(ji,jj,jk) - zsm0 ) * zwei 
     108                  a_saln = a_saln + ( tsn(ji,jj,jk,jp_sal) - zsm0 ) * zwei 
    109109                  zvol  = zvol  + zwei 
    110110               END DO 
    … …  
    177177            DO jj = mj0(ij0), mj1(ij1) 
    178178               DO jk = 1, jpk  
    179                   zt = 0.5 * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) 
    180                   zs = 0.5 * ( sn(ji,jj,jk) + sn(ji+1,jj,jk) ) 
     179                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
     180                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
    181181                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) 
    182182 
    … …  
    224224            DO jj = mj0(ij0), mj1(ij1) 
    225225               DO jk = 1, jpk  
    226                   zt = 0.5 * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) 
    227                   zs = 0.5 * ( sn(ji,jj,jk) + sn(ji+1,jj,jk) ) 
     226                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
     227                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
    228228                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) 
    229229                   
    … …  
    271271            DO jj = mj0(ij0), mj1(ij1) 
    272272               DO jk = 1, jpk  
    273                   zt = 0.5 * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) 
    274                   zs = 0.5 * ( sn(ji,jj,jk) + sn(ji+1,jj,jk) ) 
     273                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
     274                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
    275275                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) 
    276276                   
    … …  
    318318            DO jj = mj0(ij0), mj1(ij1) 
    319319               DO jk = 1, jpk 
    320                   zt = 0.5 * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) 
    321                   zs = 0.5 * ( sn(ji,jj,jk) + sn(ji+1,jj,jk) ) 
     320                  zt = 0.5 * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
     321                  zs = 0.5 * ( tsn(ji,jj,jk,jp_sal) + tsn(ji+1,jj,jk,jp_sal) ) 
    322322                  zu = un(ji,jj,jk) * fse3t(ji,jj,jk) * e2u(ji,jj) 
    323323                   

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r2528 r2789  
    107107         ! heat content variation 
    108108         zdiff_hc = zdiff_hc + SUM( surf(:,:) * tmask(:,:,jk)          & 
    109             &                       * ( fse3t_n(:,:,jk) * tn(:,:,jk)   & 
     109            &                       * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem)   & 
    110110            &                           - hc_loc_ini(:,:,jk) ) ) 
    111111         ! salt content variation 
    112112         zdiff_sc = zdiff_sc + SUM( surf(:,:) * tmask(:,:,jk)          & 
    113             &                       * ( fse3t_n(:,:,jk) * sn(:,:,jk)   & 
     113            &                       * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal)   & 
    114114            &                           - sc_loc_ini(:,:,jk) ) ) 
    115115      ENDDO 
    … …  
    248248      ! 4 - initial conservation variables ! 
    249249      ! ---------------------------------- ! 
    250       ssh_ini(:,:) = sshn(:,:)                               ! initial ssh 
     250      ssh_ini(:,:) = sshn(:,:)                                       ! initial ssh 
    251251      DO jk = 1, jpk 
    252          e3t_ini   (:,:,jk) = fse3t_n(:,:,jk)                ! initial vertical scale factors 
    253          hc_loc_ini(:,:,jk) = tn(:,:,jk) * fse3t_n(:,:,jk)   ! initial heat content 
    254          sc_loc_ini(:,:,jk) = sn(:,:,jk) * fse3t_n(:,:,jk)   ! initial salt content 
     252         e3t_ini   (:,:,jk) = fse3t_n(:,:,jk)                        ! initial vertical scale factors 
     253         hc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_tem) * fse3t_n(:,:,jk)   ! initial heat content 
     254         sc_loc_ini(:,:,jk) = tsn(:,:,jk,jp_sal) * fse3t_n(:,:,jk)   ! initial salt content 
    255255      END DO 
    256256      frc_v = 0.d0                                           ! volume       trend due to forcing 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DIA/diahth.F90

    r2715 r2789  
    160160         DO ji = 1, jpi 
    161161            IF( tmask(ji,jj,nla10) == 1. ) THEN 
    162                zu  =  1779.50 + 11.250*tn(ji,jj,nla10) - 3.80*sn(ji,jj,nla10) - 0.0745*tn(ji,jj,nla10)*tn(ji,jj,nla10)   & 
    163                   &                                                           - 0.0100*tn(ji,jj,nla10)*sn(ji,jj,nla10) 
    164                zv  =  5891.00 + 38.000*tn(ji,jj,nla10) + 3.00*sn(ji,jj,nla10) - 0.3750*tn(ji,jj,nla10)*tn(ji,jj,nla10) 
    165                zut =    11.25 -  0.149*tn(ji,jj,nla10) - 0.01*sn(ji,jj,nla10) 
    166                zvt =    38.00 -  0.750*tn(ji,jj,nla10) 
     162               zu  =  1779.50 + 11.250 * tsn(ji,jj,nla10,jp_tem) - 3.80   * tsn(ji,jj,nla10,jp_sal)                             & 
     163                  &                                              - 0.0745 * tsn(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_tem)   & 
     164                  &                                              - 0.0100 * tsn(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_sal) 
     165               zv  =  5891.00 + 38.000 * tsn(ji,jj,nla10,jp_tem) + 3.00   * tsn(ji,jj,nla10,jp_sal)                             & 
     166                  &                                              - 0.3750 * tsn(ji,jj,nla10,jp_tem) * tsn(ji,jj,nla10,jp_tem) 
     167               zut =    11.25 -  0.149 * tsn(ji,jj,nla10,jp_tem) - 0.01   * tsn(ji,jj,nla10,jp_sal) 
     168               zvt =    38.00 -  0.750 * tsn(ji,jj,nla10,jp_tem) 
    167169               zw  = (zu + 0.698*zv) * (zu + 0.698*zv) 
    168170               zdelr(ji,jj) = ztem2 * (1000.*(zut*zv - zvt*zu)/zw) 
    … …  
    184186               ! 
    185187               zzdep = fsdepw(ji,jj,jk) 
    186                zztmp = ( tn(ji,jj,jk-1) - tn(ji,jj,jk) ) / zzdep * tmask(ji,jj,jk)   ! vertical gradient of temperature (dT/dz) 
     188               zztmp = ( tsn(ji,jj,jk-1,jp_tem) - tsn(ji,jj,jk,jp_tem) ) / zzdep * tmask(ji,jj,jk)   ! vertical gradient of temperature (dT/dz) 
    187189               zzdep = zzdep * tmask(ji,jj,1) 
    188190 
    … …  
    221223               zzdep = fsdepw(ji,jj,jk) * tmask(ji,jj,1) 
    222224               ! 
    223                zztmp = tn(ji,jj,nla10) - tn(ji,jj,jk)                  ! - delta T(10m) 
     225               zztmp = tsn(ji,jj,nla10,jp_tem) - tsn(ji,jj,jk,jp_tem)  ! - delta T(10m) 
    224226               IF( ABS(zztmp) > ztem2 )      zabs2   (ji,jj) = zzdep   ! abs > 0.2 
    225227               IF(     zztmp  > ztem2 )      ztm2    (ji,jj) = zzdep   ! > 0.2 
    … …  
    254256         DO jj = 1, jpj 
    255257            DO ji = 1, jpi 
    256                zztmp = tn(ji,jj,jk) 
     258               zztmp = tsn(ji,jj,jk,jp_tem) 
    257259               IF( zztmp >= 20. )   ik20(ji,jj) = jk 
    258260               IF( zztmp >= 28. )   ik28(ji,jj) = jk 
    … …  
    273275               zztmp =      fsdept(ji,jj,iid  )   &                     ! linear interpolation 
    274276                  &  + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid)                       )   & 
    275                   &  * ( 20.*tmask(ji,jj,iid+1) -     tn(ji,jj,iid)                       )   & 
    276                   &  / (        tn(ji,jj,iid+1) -     tn(ji,jj,iid) + (1.-tmask(ji,jj,1)) ) 
     277                  &  * ( 20.*tmask(ji,jj,iid+1) - tsn(ji,jj,iid,jp_tem)                       )   & 
     278                  &  / ( tsn(ji,jj,iid+1,jp_tem) - tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) ) 
    277279               hd20(ji,jj) = MIN( zztmp , zzdep) * tmask(ji,jj,1)       ! bound by the ocean depth 
    278280            ELSE  
    … …  
    284286               zztmp =      fsdept(ji,jj,iid  )   &                     ! linear interpolation 
    285287                  &  + (    fsdept(ji,jj,iid+1) - fsdept(ji,jj,iid)                       )   & 
    286                   &  * ( 28.*tmask(ji,jj,iid+1) -     tn(ji,jj,iid)                       )   & 
    287                   &  / (        tn(ji,jj,iid+1) -     tn(ji,jj,iid) + (1.-tmask(ji,jj,1)) ) 
     288                  &  * ( 28.*tmask(ji,jj,iid+1) -    tsn(ji,jj,iid,jp_tem)                       )   & 
     289                  &  / (  tsn(ji,jj,iid+1,jp_tem) -    tsn(ji,jj,iid,jp_tem) + (1.-tmask(ji,jj,1)) ) 
    288290               hd28(ji,jj) = MIN( zztmp , zzdep ) * tmask(ji,jj,1)      ! bound by the ocean depth 
    289291            ELSE  
    … …  
    309311      ! surface boundary condition 
    310312      IF( lk_vvl ) THEN   ;   zthick(:,:) = 0._wp       ;   htc3(:,:) = 0._wp                                    
    311       ELSE                ;   zthick(:,:) = sshn(:,:)   ;   htc3(:,:) = tn(:,:,jk) * sshn(:,:) * tmask(:,:,jk)    
     313      ELSE                ;   zthick(:,:) = sshn(:,:)   ;   htc3(:,:) = tsn(:,:,jk,jp_tem) * sshn(:,:) * tmask(:,:,jk)    
    312314      ENDIF 
    313315      ! integration down to ilevel 
    314316      DO jk = 1, ilevel 
    315317         zthick(:,:) = zthick(:,:) + fse3t(:,:,jk) 
    316          htc3  (:,:) = htc3  (:,:) + fse3t(:,:,jk) * tn(:,:,jk) * tmask(:,:,jk) 
     318         htc3  (:,:) = htc3  (:,:) + fse3t(:,:,jk) * tsn(:,:,jk,jp_tem) * tmask(:,:,jk) 
    317319      END DO 
    318320      ! deepest layer 
    … …  
    320322      DO jj = 1, jpj 
    321323         DO ji = 1, jpi 
    322             htc3(ji,jj) = htc3(ji,jj) + tn(ji,jj,ilevel+1) * MIN( fse3t(ji,jj,ilevel+1), zthick(ji,jj) ) * tmask(ji,jj,ilevel+1) 
     324            htc3(ji,jj) = htc3(ji,jj) + tsn(ji,jj,ilevel+1,jp_tem) * MIN( fse3t(ji,jj,ilevel+1), zthick(ji,jj) ) * tmask(ji,jj,ilevel+1) 
    323325         END DO 
    324326      END DO 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90

    r2715 r2789  
    349349            IF( ln_diaznl ) THEN               ! i-mean temperature and salinity 
    350350               DO jn = 1, nptr 
    351                   tn_jk(:,:,jn) = ptr_tjk( tn(:,:,:), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
     351                  tn_jk(:,:,jn) = ptr_tjk( tsn(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 
    352352               END DO 
    353353            ENDIF 
    … …  
    368368            ! 
    369369            !                          ! Transports 
    370             !                                ! local heat & salt transports at T-points  ( tn*mj[vn+v_eiv] ) 
     370            !                                ! local heat & salt transports at T-points  ( tsn*mj[vn+v_eiv] ) 
    371371            vt(:,:,jpk) = 0._wp   ;   vs(:,:,jpk) = 0._wp 
    372372            DO jk= 1, jpkm1 
    … …  
    378378                     zv = ( vn(ji,jj,jk) + vn(ji,jj-1,jk) ) * 0.5_wp 
    379379#endif  
    380                      vt(:,jj,jk) = zv * tn(:,jj,jk) 
    381                      vs(:,jj,jk) = zv * sn(:,jj,jk) 
     380                     vt(:,jj,jk) = zv * tsn(:,jj,jk,jp_tem) 
     381                     vs(:,jj,jk) = zv * tsn(:,jj,jk,jp_sal) 
    382382                  END DO 
    383383               END DO 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r2715 r2789  
    4646   USE limwri_2  
    4747#endif 
    48    USE dtatem 
    49    USE dtasal 
    5048   USE lib_mpp         ! MPP library 
    5149 
    … …  
    116114      !! ** Method  :  use iom_put 
    117115      !!---------------------------------------------------------------------- 
    118       USE oce, ONLY :   z3d => ta   ! use ta as 3D workspace 
    119116      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     117      USE wrk_nemo, ONLY: z3d => wrk_3d_1 
    120118      USE wrk_nemo, ONLY: z2d => wrk_2d_1 
    121119      !! 
    … …  
    126124      !!---------------------------------------------------------------------- 
    127125      !  
    128       IF( wrk_in_use(2, 1))THEN 
    129          CALL ctl_stop('dia_wri: ERROR - requested 2D workspace unavailable.') 
    130          RETURN 
     126      IF(  wrk_in_use(3, 1) .OR. wrk_in_use(2, 1) ) THEN 
     127         CALL ctl_stop('dia_wri: ERROR - requested 2D workspace unavailable.')  ;  RETURN 
    131128      END IF 
    132129      ! 
    … …  
    137134      ENDIF 
    138135 
    139       CALL iom_put( "toce"   , tn                    )    ! temperature 
    140       CALL iom_put( "soce"   , sn                    )    ! salinity 
    141       CALL iom_put( "sst"    , tn(:,:,1)             )    ! sea surface temperature 
    142       CALL iom_put( "sst2"   , tn(:,:,1) * tn(:,:,1) )    ! square of sea surface temperature 
    143       CALL iom_put( "sss"    , sn(:,:,1)             )    ! sea surface salinity 
    144       CALL iom_put( "sss2"   , sn(:,:,1) * sn(:,:,1) )    ! square of sea surface salinity 
    145       CALL iom_put( "uoce"   , un                    )    ! i-current       
    146       CALL iom_put( "voce"   , vn                    )    ! j-current 
     136      CALL iom_put( "toce"   , tsn(:,:,:,jp_tem)                     )    ! temperature 
     137      CALL iom_put( "soce"   , tsn(:,:,:,jp_sal)                     )    ! salinity 
     138      CALL iom_put( "sst"    , tsn(:,:,1,jp_tem)                     )    ! sea surface temperature 
     139      CALL iom_put( "sst2"   , tsn(:,:,1,jp_tem) * tsn(:,:,1,jp_tem) )    ! square of sea surface temperature 
     140      CALL iom_put( "sss"    , tsn(:,:,1,jp_sal)                     )    ! sea surface salinity 
     141      CALL iom_put( "sss2"   , tsn(:,:,1,jp_sal) * tsn(:,:,1,jp_sal) )    ! square of sea surface salinity 
     142      CALL iom_put( "uoce"   , un                                    )    ! i-current       
     143      CALL iom_put( "voce"   , vn                                    )    ! j-current 
    147144       
    148       CALL iom_put( "avt"    , avt                   )    ! T vert. eddy diff. coef. 
    149       CALL iom_put( "avm"    , avmu                  )    ! T vert. eddy visc. coef. 
     145      CALL iom_put( "avt"    , avt                                   )    ! T vert. eddy diff. coef. 
     146      CALL iom_put( "avm"    , avmu                                  )    ! T vert. eddy visc. coef. 
    150147      IF( lk_zdfddm ) THEN 
    151          CALL iom_put( "avs" , fsavs(:,:,:)          )    ! S vert. eddy diff. coef. 
     148         CALL iom_put( "avs" , fsavs(:,:,:)                          )    ! S vert. eddy diff. coef. 
    152149      ENDIF 
    153150 
    154151      DO jj = 2, jpjm1                                    ! sst gradient 
    155152         DO ji = fs_2, fs_jpim1   ! vector opt. 
    156             zztmp      = tn(ji,jj,1) 
    157             zztmpx     = ( tn(ji+1,jj  ,1) - zztmp ) / e1u(ji,jj) + ( zztmp - tn(ji-1,jj  ,1) ) / e1u(ji-1,jj  ) 
    158             zztmpy     = ( tn(ji  ,jj+1,1) - zztmp ) / e2v(ji,jj) + ( zztmp - tn(ji  ,jj-1,1) ) / e2v(ji  ,jj-1) 
     153            zztmp      = tsn(ji,jj,1,jp_tem) 
     154            zztmpx     = ( tsn(ji+1,jj  ,1,jp_tem) - zztmp ) / e1u(ji,jj) + ( zztmp - tsn(ji-1,jj  ,1,jp_tem) ) / e1u(ji-1,jj  ) 
     155            zztmpy     = ( tsn(ji  ,jj+1,1,jp_tem) - zztmp ) / e2v(ji,jj) + ( zztmp - tsn(ji  ,jj-1,1,jp_tem) ) / e2v(ji  ,jj-1) 
    159156            z2d(ji,jj) = 0.25 * ( zztmpx * zztmpx + zztmpy * zztmpy )   & 
    160157               &              * umask(ji,jj,1) * umask(ji-1,jj,1) * vmask(ji,jj,1) * umask(ji,jj-1,1) 
    … …  
    178175            DO jj = 2, jpjm1 
    179176               DO ji = fs_2, fs_jpim1   ! vector opt. 
    180                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tn(ji,jj,jk) + tn(ji+1,jj,jk) ) 
     177                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji+1,jj,jk,jp_tem) ) 
    181178               END DO 
    182179            END DO 
    … …  
    192189            DO jj = 2, jpjm1 
    193190               DO ji = fs_2, fs_jpim1   ! vector opt. 
    194                   z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tn(ji,jj,jk) + tn(ji,jj+1,jk) ) 
     191                  z2d(ji,jj) = z2d(ji,jj) + z3d(ji,jj,jk) * zztmp * ( tsn(ji,jj,jk,jp_tem) + tsn(ji,jj+1,jk,jp_tem) ) 
    195192               END DO 
    196193            END DO 
    … …  
    200197      ENDIF 
    201198      ! 
    202       IF( wrk_not_released(2, 1))THEN 
     199      IF( wrk_not_released(3, 1) .OR. wrk_not_released(2, 1) ) THEN 
    203200         CALL ctl_stop('dia_wri: ERROR - failed to release 2D workspace.') 
    204201         RETURN 
    … …  
    516513 
    517514      ! Write fields on T grid 
    518       CALL histwrite( nid_T, "votemper", it, tn            , ndim_T , ndex_T  )   ! temperature 
    519       CALL histwrite( nid_T, "vosaline", it, sn            , ndim_T , ndex_T  )   ! salinity 
    520       CALL histwrite( nid_T, "sosstsst", it, tn(:,:,1)     , ndim_hT, ndex_hT )   ! sea surface temperature 
    521       CALL histwrite( nid_T, "sosaline", it, sn(:,:,1)     , ndim_hT, ndex_hT )   ! sea surface salinity 
     515      CALL histwrite( nid_T, "votemper", it, tsn(:,:,:,jp_tem), ndim_T , ndex_T  )   ! temperature 
     516      CALL histwrite( nid_T, "vosaline", it, tsn(:,:,:,jp_sal), ndim_T , ndex_T  )   ! salinity 
     517      CALL histwrite( nid_T, "sosstsst", it, tsn(:,:,1,jp_tem), ndim_hT, ndex_hT )   ! sea surface temperature 
     518      CALL histwrite( nid_T, "sosaline", it, tsn(:,:,1,jp_sal), ndim_hT, ndex_hT )   ! sea surface salinity 
    522519      CALL histwrite( nid_T, "sossheig", it, sshn          , ndim_hT, ndex_hT )   ! sea surface height 
    523520!!$#if  defined key_lim3 || defined key_lim2  
    … …  
    528525!!$      CALL histwrite( nid_T, "sorunoff", it, runoff        , ndim_hT, ndex_hT )   ! runoff 
    529526      CALL histwrite( nid_T, "sowaflcd", it, ( emps-rnf )  , ndim_hT, ndex_hT )   ! c/d water flux 
    530       zw2d(:,:) = ( emps(:,:) - rnf(:,:) ) * sn(:,:,1) * tmask(:,:,1) 
     527      zw2d(:,:) = ( emps(:,:) - rnf(:,:) ) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    531528      CALL histwrite( nid_T, "sosalflx", it, zw2d          , ndim_hT, ndex_hT )   ! c/d salt flux 
    532529      CALL histwrite( nid_T, "sohefldo", it, qns + qsr     , ndim_hT, ndex_hT )   ! total heat flux 
    … …  
    539536      CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    540537      CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    541       IF( ln_ssr ) zw2d(:,:) = erp(:,:) * sn(:,:,1) * tmask(:,:,1) 
     538      IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    542539      CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    543540#endif 
    … …  
    545542      CALL histwrite( nid_T, "sohefldp", it, qrp           , ndim_hT, ndex_hT )   ! heat flux damping 
    546543      CALL histwrite( nid_T, "sowafldp", it, erp           , ndim_hT, ndex_hT )   ! freshwater flux damping 
    547          IF( ln_ssr ) zw2d(:,:) = erp(:,:) * sn(:,:,1) * tmask(:,:,1) 
     544         IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 
    548545      CALL histwrite( nid_T, "sosafldp", it, zw2d          , ndim_hT, ndex_hT )   ! salt flux damping 
    549546#endif 
    … …  
    711708 
    712709      ! Write all fields on T grid 
    713       CALL histwrite( id_i, "votemper", kt, tn      , jpi*jpj*jpk, idex )    ! now temperature 
    714       CALL histwrite( id_i, "vosaline", kt, sn      , jpi*jpj*jpk, idex )    ! now salinity 
    715       CALL histwrite( id_i, "sossheig", kt, sshn     , jpi*jpj    , idex )    ! sea surface height 
    716       CALL histwrite( id_i, "vozocrtx", kt, un       , jpi*jpj*jpk, idex )    ! now i-velocity 
    717       CALL histwrite( id_i, "vomecrty", kt, vn       , jpi*jpj*jpk, idex )    ! now j-velocity 
    718       CALL histwrite( id_i, "vovecrtz", kt, wn       , jpi*jpj*jpk, idex )    ! now k-velocity 
    719       CALL histwrite( id_i, "sowaflup", kt, (emp-rnf), jpi*jpj    , idex )    ! freshwater budget 
    720       CALL histwrite( id_i, "sohefldo", kt, qsr + qns, jpi*jpj    , idex )    ! total heat flux 
    721       CALL histwrite( id_i, "soshfldo", kt, qsr      , jpi*jpj    , idex )    ! solar heat flux 
    722       CALL histwrite( id_i, "soicecov", kt, fr_i     , jpi*jpj    , idex )    ! ice fraction 
    723       CALL histwrite( id_i, "sozotaux", kt, utau     , jpi*jpj    , idex )    ! i-wind stress 
    724       CALL histwrite( id_i, "sometauy", kt, vtau     , jpi*jpj    , idex )    ! j-wind stress 
     710      CALL histwrite( id_i, "votemper", kt, tsn(:,:,:,jp_tem), jpi*jpj*jpk, idex )    ! now temperature 
     711      CALL histwrite( id_i, "vosaline", kt, tsn(:,:,:,jp_sal), jpi*jpj*jpk, idex )    ! now salinity 
     712      CALL histwrite( id_i, "sossheig", kt, sshn             , jpi*jpj    , idex )    ! sea surface height 
     713      CALL histwrite( id_i, "vozocrtx", kt, un               , jpi*jpj*jpk, idex )    ! now i-velocity 
     714      CALL histwrite( id_i, "vomecrty", kt, vn               , jpi*jpj*jpk, idex )    ! now j-velocity 
     715      CALL histwrite( id_i, "vovecrtz", kt, wn               , jpi*jpj*jpk, idex )    ! now k-velocity 
     716      CALL histwrite( id_i, "sowaflup", kt, (emp-rnf )       , jpi*jpj    , idex )    ! freshwater budget 
     717      CALL histwrite( id_i, "sohefldo", kt, qsr + qns        , jpi*jpj    , idex )    ! total heat flux 
     718      CALL histwrite( id_i, "soshfldo", kt, qsr              , jpi*jpj    , idex )    ! solar heat flux 
     719      CALL histwrite( id_i, "soicecov", kt, fr_i             , jpi*jpj    , idex )    ! ice fraction 
     720      CALL histwrite( id_i, "sozotaux", kt, utau             , jpi*jpj    , idex )    ! i-wind stress 
     721      CALL histwrite( id_i, "sometauy", kt, vtau             , jpi*jpj    , idex )    ! j-wind stress 
    725722 
    726723      ! 3. Close the file 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90

    r2715 r2789  
    152152       wm(:,:,:)=wm(:,:,:) + wn (:,:,:) 
    153153       avtm(:,:,:)=avtm(:,:,:) + avt (:,:,:) 
    154        tm(:,:,:)=tm(:,:,:) + tn (:,:,:) 
    155        sm(:,:,:)=sm(:,:,:) + sn (:,:,:) 
     154       tm(:,:,:)=tm(:,:,:) + tsn(:,:,:,jp_tem) 
     155       sm(:,:,:)=sm(:,:,:) + tsn(:,:,:,jp_sal) 
    156156       ! 
    157157       fsel(:,:,1 ) = fsel(:,:,1 ) + utau(:,:) * umask(:,:,1) 
    … …  
    159159       fsel(:,:,3 ) = fsel(:,:,3 ) + qsr (:,:) + qns  (:,:)  
    160160       fsel(:,:,4 ) = fsel(:,:,4 ) + ( emp(:,:)-rnf(:,:) )  
    161        !        fsel(:,:,5 ) = fsel(:,:,5 ) + tb  (:,:,1)  !RB not used 
     161       !        fsel(:,:,5 ) = fsel(:,:,5 ) + tsb(:,:,1,jp_tem)  !RB not used 
    162162       fsel(:,:,6 ) = fsel(:,:,6 ) + sshn(:,:)  
    163163       fsel(:,:,7 ) = fsel(:,:,7 ) + qsr(:,:) 
    … …  
    226226          fsel(:,:,3 ) = (qsr (:,:) + qns (:,:)) * tmask(:,:,1) 
    227227          fsel(:,:,4 ) = ( emp(:,:)-rnf(:,:) ) * tmask(:,:,1)  
    228           !         fsel(:,:,5 ) = (tb  (:,:,1) - sf_sst(1)%fnow(:,:) ) *tmask(:,:,1) !RB not used 
     228          !         fsel(:,:,5 ) = (tsb(:,:,1,jp_tem) - sf_sst(1)%fnow(:,:) ) *tmask(:,:,1) !RB not used 
    229229 
    230230          fsel(:,:,6 ) = sshn(:,:) 
    … …  
    302302 
    303303       IF( ll_dia_inst) THEN 
    304           CALL dia_wri_dimg(clname, cltext, tn, jpk, 'T') 
    305        ELSE 
    306           CALL dia_wri_dimg(clname, cltext, tm, jpk, 'T') 
     304          CALL dia_wri_dimg(clname, cltext, tsn(:,:,:,jp_tem), jpk, 'T') 
     305       ELSE 
     306          CALL dia_wri_dimg(clname, cltext, tm               , jpk, 'T') 
    307307       ENDIF 
    308308       ! 
    … …  
    314314 
    315315       IF( ll_dia_inst) THEN 
    316           CALL dia_wri_dimg(clname, cltext, sn, jpk, 'T') 
    317        ELSE 
    318           CALL dia_wri_dimg(clname, cltext, sm, jpk, 'T') 
     316          CALL dia_wri_dimg(clname, cltext, tsn(:,:,:,jp_sal), jpk, 'T') 
     317       ELSE 
     318          CALL dia_wri_dimg(clname, cltext, sm               , jpk, 'T') 
    319319       ENDIF 
    320320       ! 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r2777 r2789  
    1313   !!            2.0  !  2006-07  (S. Masson)  distributed restart using iom 
    1414   !!            3.3  !  2010-10  (C. Ethe) merge TRC-TRA 
     15   !!            3.4  !  2011-04  (G. Madec) Merge of dtatem and dtasal & suppression of tb,tn/sb,sn  
    1516   !!---------------------------------------------------------------------- 
    1617 
    … …  
    3031   USE zdf_oce         ! ocean vertical physics 
    3132   USE phycst          ! physical constants 
    32    USE dtatem          ! temperature data                 (dta_tem routine) 
    33    USE dtasal          ! salinity data                    (dta_sal routine) 
     33   USE dtatsd          ! data temperature and salinity   (dta_tsd routine) 
    3434   USE restart         ! ocean restart                   (rst_read routine) 
    3535   USE in_out_manager  ! I/O manager 
    … …  
    4242   USE dynspg_exp      ! pressure gradient schemes 
    4343   USE dynspg_ts       ! pressure gradient schemes 
    44    USE traswp          ! Swap arrays                      (tra_swp routine) 
    4544   USE lib_mpp         ! MPP library 
    4645 
    … …  
    7372      IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    7473 
    75       rhd  (:,:,:) = 0.e0 
    76       rhop (:,:,:) = 0.e0 
    77       rn2  (:,:,:) = 0.e0  
    78       ta   (:,:,:) = 0.e0     
    79       sa   (:,:,:) = 0.e0 
     74      CALL dta_tsd_init                       ! Initialisation of T & S input data 
     75 
     76      rhd  (:,:,:  ) = 0.e0 
     77      rhop (:,:,:  ) = 0.e0 
     78      rn2  (:,:,:  ) = 0.e0  
     79      tsa  (:,:,:,:) = 0.e0     
    8080 
    8181      IF( ln_rstart ) THEN                    ! Restart from a file 
    … …  
    8383         neuler = 1                              ! Set time-step indicator at nit000 (leap-frog) 
    8484         CALL rst_read                           ! Read the restart file 
    85          CALL tra_swap                           ! swap 3D arrays (t,s)  in a 4D array (ts) 
    8685         CALL day_init                           ! model calendar (using both namelist and restart infos) 
    8786      ELSE 
    … …  
    9998         hdivb(:,:,:) = 0.e0   ;   hdivn(:,:,:) = 0.e0 
    10099         ! 
    101          IF( cp_cfg == 'eel' ) THEN 
     100         IF( cp_cfg == 'eel'      ) THEN 
    102101            CALL istate_eel                      ! EEL   configuration : start from pre-defined U,V T-S fields 
    103102         ELSEIF( cp_cfg == 'gyre' ) THEN          
    104103            CALL istate_gyre                     ! GYRE  configuration : start from pre-defined T-S fields 
    105          ELSE 
    106             !                                    ! Other configurations: Initial T-S fields 
    107 #if defined key_dtatem 
    108             CALL dta_tem( nit000 )                  ! read 3D temperature data 
    109             tb(:,:,:) = t_dta(:,:,:)   ;   tn(:,:,:) = t_dta(:,:,:) 
    110              
    111 #else 
    112             IF(lwp) WRITE(numout,*)                 ! analytical temperature profile 
    113             IF(lwp) WRITE(numout,*)'             Temperature initialization using an analytic profile' 
    114             CALL istate_tem 
    115 #endif 
    116 #if defined key_dtasal 
    117             CALL dta_sal( nit000 )                  ! read 3D salinity data 
    118             sb(:,:,:) = s_dta(:,:,:)   ;   sn(:,:,:) = s_dta(:,:,:) 
    119 #else 
    120             ! No salinity data 
    121             IF(lwp)WRITE(numout,*)                  ! analytical salinity profile 
    122             IF(lwp)WRITE(numout,*)'             Salinity initialisation using a constant value' 
    123             CALL istate_sal 
    124 #endif 
     104         ELSEIF( ln_tsd_init      ) THEN         ! Initial T-S fields read in files 
     105            CALL dta_tsd( nit000, tsb )                  ! read 3D T and S data at nit000 
     106            tsn(:,:,:,:) = tsb(:,:,:,:) 
     107            ! 
     108         ELSE                                    ! Initial T-S fields defined analytically 
     109            CALL istate_t_s 
    125110         ENDIF 
    126111         ! 
    127          CALL tra_swap                     ! swap 3D arrays (tb,sb,tn,sn)  in a 4D array 
    128112         CALL eos( tsb, rhd, rhop )        ! before potential and in situ densities 
    129113#if ! defined key_c1d 
    … …  
    150134   END SUBROUTINE istate_init 
    151135 
    152  
    153    SUBROUTINE istate_tem 
     136   SUBROUTINE istate_t_s 
    154137      !!--------------------------------------------------------------------- 
    155       !!                  ***  ROUTINE istate_tem  *** 
     138      !!                  ***  ROUTINE istate_t_s  *** 
    156139      !!    
    157140      !! ** Purpose :   Intialization of the temperature field with an  
    158141      !!      analytical profile or a file (i.e. in EEL configuration) 
    159142      !! 
    160       !! ** Method  :   Use Philander analytic profile of temperature 
     143      !! ** Method  : - temperature: use Philander analytic profile 
     144      !!              - salinity   : use to a constant value 35.5 
    161145      !! 
    162146      !! References :  Philander ??? 
    163147      !!---------------------------------------------------------------------- 
    164       INTEGER :: ji, jj, jk 
     148      INTEGER  :: ji, jj, jk 
     149      REAL(wp) ::   zsal = 35.50 
    165150      !!---------------------------------------------------------------------- 
    166151      ! 
    167152      IF(lwp) WRITE(numout,*) 
    168       IF(lwp) WRITE(numout,*) 'istate_tem : initial temperature profile' 
    169       IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
     153      IF(lwp) WRITE(numout,*) 'istate_t_s : Philander s initial temperature profile' 
     154      IF(lwp) WRITE(numout,*) '~~~~~~~~~~   and constant salinity (',zsal,' psu)' 
    170155      ! 
    171156      DO jk = 1, jpk 
    172          DO jj = 1, jpj 
    173             DO ji = 1, jpi 
    174                tn(ji,jj,jk) = (  ( ( 7.5 - 0.*ABS(gphit(ji,jj))/30. )   & 
    175                   &               *( 1.-TANH((fsdept(ji,jj,jk)-80.)/30.) )   & 
    176                   &            + 10.*(5000.-fsdept(ji,jj,jk))/5000.)  ) * tmask(ji,jj,jk) 
    177                tb(ji,jj,jk) = tn(ji,jj,jk) 
    178           END DO 
    179         END DO 
     157         tsn(:,:,jk,jp_tem) = (  ( ( 7.5 - 0. * ABS( gphit(:,:) )/30. ) * ( 1.-TANH((fsdept(:,:,jk)-80.)/30.) )   & 
     158            &                + 10. * ( 5000. - fsdept(:,:,jk) ) /5000.)  ) * tmask(:,:,jk) 
     159         tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem) 
    180160      END DO 
    181       ! 
    182       IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   & 
    183          &                 1     , jpi   , 5     , 1     , jpk   ,   & 
    184          &                 1     , 1.    , numout                  ) 
    185       ! 
    186    END SUBROUTINE istate_tem 
    187  
    188  
    189    SUBROUTINE istate_sal 
    190       !!--------------------------------------------------------------------- 
    191       !!                  ***  ROUTINE istate_sal  *** 
    192       !! 
    193       !! ** Purpose :   Intialize the salinity field with an analytic profile 
    194       !! 
    195       !! ** Method  :   Use to a constant value 35.5 
    196       !!               
    197       !! ** Action  :   Initialize sn and sb 
    198       !!---------------------------------------------------------------------- 
    199       REAL(wp) ::   zsal = 35.50_wp 
    200       !!---------------------------------------------------------------------- 
    201       ! 
    202       IF(lwp) WRITE(numout,*) 
    203       IF(lwp) WRITE(numout,*) 'istate_sal : initial salinity : ', zsal 
    204       IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    205       ! 
    206       sn(:,:,:) = zsal * tmask(:,:,:) 
    207       sb(:,:,:) = sn(:,:,:) 
    208       ! 
    209    END SUBROUTINE istate_sal 
     161      tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:) 
     162      tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 
     163      ! 
     164   END SUBROUTINE istate_t_s 
    210165 
    211166 
    … …  
    254209            ! 
    255210            DO jk = 1, jpk 
    256                tn(:,:,jk) = ( zt2 + zt1 * exp( - fsdept(:,:,jk) / 1000 ) ) * tmask(:,:,jk) 
    257                tb(:,:,jk) = tn(:,:,jk) 
     211               tsn(:,:,jk,jp_tem) = ( zt2 + zt1 * exp( - fsdept(:,:,jk) / 1000 ) ) * tmask(:,:,jk) 
     212               tsb(:,:,jk,jp_tem) = tsn(:,:,jk,jp_tem) 
    258213            END DO 
    259214            ! 
    260             IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   & 
    261                &                 1     , jpi   , 5     , 1     , jpk   ,   & 
    262                &                 1     , 1.    , numout                  ) 
     215            IF(lwp) CALL prizre( tsn(:,:,:,jp_tem), jpi   , jpj   , jpk   , jpj/2 ,   & 
     216               &                             1     , jpi   , 5     , 1     , jpk   ,   & 
     217               &                             1     , 1.    , numout                  ) 
    263218            ! 
    264219            ! set salinity field to a constant value 
    … …  
    268223            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    269224            ! 
    270             sn(:,:,:) = zsal * tmask(:,:,:) 
    271             sb(:,:,:) = sn(:,:,:) 
     225            tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:) 
     226            tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 
    272227            ! 
    273228            ! set the dynamics: U,V, hdiv, rot (and ssh if necessary) 
    … …  
    323278            ! 
    324279            CALL iom_open ( 'eel.initemp', inum ) 
    325             CALL iom_get ( inum, jpdom_data, 'initemp', tb ) ! read before temprature (tb) 
     280            CALL iom_get ( inum, jpdom_data, 'initemp', tsb(:,:,:,jp_tem) ) ! read before temprature (tb) 
    326281            CALL iom_close( inum ) 
    327282            ! 
    328             tn(:,:,:) = tb(:,:,:)                            ! set nox temperature to tb 
    329             ! 
    330             IF(lwp) CALL prizre( tn    , jpi   , jpj   , jpk   , jpj/2 ,   & 
    331                &                 1     , jpi   , 5     , 1     , jpk   ,   & 
    332                &                 1     , 1.    , numout                  ) 
     283            tsn(:,:,:,jp_tem) = tsb(:,:,:,jp_tem)                            ! set nox temperature to tb 
     284            ! 
     285            IF(lwp) CALL prizre( tsn(:,:,:,jp_tem), jpi   , jpj   , jpk   , jpj/2 ,   & 
     286               &                            1     , jpi   , 5     , 1     , jpk   ,   & 
     287               &                            1     , 1.    , numout                  ) 
    333288            ! 
    334289            ! set salinity field to a constant value 
    … …  
    338293            IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    339294            ! 
    340             sn(:,:,:) = zsal * tmask(:,:,:) 
    341             sb(:,:,:) = sn(:,:,:) 
     295            tsn(:,:,:,jp_sal) = zsal * tmask(:,:,:) 
     296            tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 
    342297            ! 
    343298            !                                    ! =========================== 
    … …  
    377332            DO jj = 1, jpj 
    378333               DO ji = 1, jpi 
    379                   tn(ji,jj,jk) = (  16. - 12. * TANH( (fsdept(ji,jj,jk) - 400) / 700 )         )   & 
     334                  tsn(ji,jj,jk,jp_tem) = (  16. - 12. * TANH( (fsdept(ji,jj,jk) - 400) / 700 )         )   & 
    380335                       &           * (-TANH( (500-fsdept(ji,jj,jk)) / 150 ) + 1) / 2               & 
    381336                       &       + (      15. * ( 1. - TANH( (fsdept(ji,jj,jk)-50.) / 1500.) )       & 
    … …  
    383338                       &                + 7.  * (1500. - fsdept(ji,jj,jk)) / 1500.             )   &  
    384339                       &           * (-TANH( (fsdept(ji,jj,jk) - 500) / 150) + 1) / 2 
    385                   tn(ji,jj,jk) = tn(ji,jj,jk) * tmask(ji,jj,jk) 
    386                   tb(ji,jj,jk) = tn(ji,jj,jk) 
    387  
    388                   sn(ji,jj,jk) =  (  36.25 - 1.13 * TANH( (fsdept(ji,jj,jk) - 305) / 460 )  )  & 
     340                  tsn(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) * tmask(ji,jj,jk) 
     341                  tsb(ji,jj,jk,jp_tem) = tsn(ji,jj,jk,jp_tem) 
     342 
     343                  tsn(ji,jj,jk,jp_sal) =  (  36.25 - 1.13 * TANH( (fsdept(ji,jj,jk) - 305) / 460 )  )  & 
    389344                     &              * (-TANH((500 - fsdept(ji,jj,jk)) / 150) + 1) / 2          & 
    390345                     &          + (  35.55 + 1.25 * (5000. - fsdept(ji,jj,jk)) / 5000.         & 
    … …  
    393348                     &                + 0.2  * TANH( (fsdept(ji,jj,jk) - 1000.) / 5000.)    )  & 
    394349                     &              * (-TANH((fsdept(ji,jj,jk) - 500) / 150) + 1) / 2  
    395                   sn(ji,jj,jk) = sn(ji,jj,jk) * tmask(ji,jj,jk) 
    396                   sb(ji,jj,jk) = sn(ji,jj,jk) 
     350                  tsn(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) * tmask(ji,jj,jk) 
     351                  tsb(ji,jj,jk,jp_sal) = tsn(ji,jj,jk,jp_sal) 
    397352               END DO 
    398353            END DO 
    … …  
    408363         ! ---------------------- 
    409364         CALL iom_open ( 'data_tem', inum ) 
    410          CALL iom_get ( inum, jpdom_data, 'votemper', tn )  
     365         CALL iom_get ( inum, jpdom_data, 'votemper', tsn(:,:,:,jp_tem) )  
    411366         CALL iom_close( inum ) 
    412367 
    413          tn(:,:,:) = tn(:,:,:) * tmask(:,:,:)  
    414          tb(:,:,:) = tn(:,:,:) 
     368         tsn(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) * tmask(:,:,:)  
     369         tsb(:,:,:,jp_tem) = tsn(:,:,:,jp_tem) 
    415370 
    416371         ! Read salinity field 
    417372         ! ------------------- 
    418373         CALL iom_open ( 'data_sal', inum ) 
    419          CALL iom_get ( inum, jpdom_data, 'vosaline', sn )  
     374         CALL iom_get ( inum, jpdom_data, 'vosaline', tsn(:,:,:,jp_sal) )  
    420375         CALL iom_close( inum ) 
    421376 
    422          sn(:,:,:)  = sn(:,:,:) * tmask(:,:,:)  
    423          sb(:,:,:)  = sn(:,:,:) 
     377         tsn(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) * tmask(:,:,:)  
     378         tsb(:,:,:,jp_sal) = tsn(:,:,:,jp_sal) 
    424379 
    425380      END SELECT 
    … …  
    429384         WRITE(numout,*) '              Initial temperature and salinity profiles:' 
    430385         WRITE(numout, "(9x,' level   gdept_0   temperature   salinity   ')" ) 
    431          WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_0(jk), tn(2,2,jk), sn(2,2,jk), jk = 1, jpk ) 
     386         WRITE(numout, "(10x, i4, 3f10.2)" ) ( jk, gdept_0(jk), tsn(2,2,jk,jp_tem), tsn(2,2,jk,jp_sal), jk = 1, jpk ) 
    432387      ENDIF 
    433388 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_cen2.F90

    r2715 r2789  
    4848      !!---------------------------------------------------------------------- 
    4949      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    50       USE oce     , ONLY:   zfu   => ta       , zfv   => sa       ! (ta,sa) used as 3D workspace 
     50      USE oce     , ONLY:   tsa             ! tsa used as 2 3D workspace 
    5151      USE wrk_nemo, ONLY:   zfu_t => wrk_3d_1 , zfv_t => wrk_3d_4 , zfu_uw =>wrk_3d_6   ! 3D workspaces 
    5252      USE wrk_nemo, ONLY:   zfu_f => wrk_3d_2 , zfv_f => wrk_3d_5 , zfv_vw =>wrk_3d_7 
    53       USE wrk_nemo, ONLY:   zfw   => wrk_3d_3  
     53      USE wrk_nemo, ONLY:   zfw   => wrk_3d_3 
    5454      ! 
    5555      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    … …  
    5757      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    5858      REAL(wp) ::   zbu, zbv     ! local scalars 
     59      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zfu, zfv 
    5960      !!---------------------------------------------------------------------- 
    6061 
    … …  
    6970         CALL ctl_stop('dyn_adv_cen2 : requested workspace array unavailable')   ;   RETURN 
    7071      ENDIF 
    71  
     72      ! 
     73      zfu => tsa(:,:,:,1)  
     74      zfv => tsa(:,:,:,2)  
     75      ! 
    7276      IF( l_trddyn ) THEN           ! Save ua and va trends 
    7377         zfu_uw(:,:,:) = ua(:,:,:) 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DYN/dynadv_ubs.F90

    r2715 r2789  
    6969      !!---------------------------------------------------------------------- 
    7070      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    71       USE oce     , ONLY:   zfu    => ta       , zfv    => sa      ! (ta,sa) used as 3D workspace 
     71      USE oce     , ONLY:   tsa             ! tsa used as 2 3D workspace 
    7272      USE wrk_nemo, ONLY:   zfu_t  => wrk_3d_1 , zfv_t  =>wrk_3d_4 , zfu_uw =>wrk_3d_6   ! 3D workspace 
    7373      USE wrk_nemo, ONLY:   zfu_f  => wrk_3d_2 , zfv_f  =>wrk_3d_5 , zfv_vw =>wrk_3d_7 
    … …  
    8181      REAL(wp) ::   zbu, zbv    ! temporary scalars 
    8282      REAL(wp) ::   zui, zvj, zfuj, zfvi, zl_u, zl_v   ! temporary scalars 
     83      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zfu, zfv 
    8384      !!---------------------------------------------------------------------- 
    8485 
    … …  
    9394         CALL ctl_stop('dyn_adv_ubs: requested workspace array unavailable')   ;   RETURN 
    9495      ENDIF 
    95  
     96      ! 
     97      zfu => tsa(:,:,:,1)  
     98      zfv => tsa(:,:,:,2)  
     99      ! 
    96100      zfu_t(:,:,:) = 0._wp 
    97101      zfv_t(:,:,:) = 0._wp 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90

    r2715 r2789  
    7777      !!             - Save the trend (l_trddyn=T) 
    7878      !!---------------------------------------------------------------------- 
    79       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    80       USE wrk_nemo, ONLY:   ztrdu => wrk_3d_1 , ztrdv => wrk_3d_2   ! 3D workspace 
     79      USE oce, ONLY:   tsa                         ! (tsa) used as 2 3D workspace 
    8180      !! 
    8281      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    83       !!---------------------------------------------------------------------- 
    84       ! 
    85       IF( wrk_in_use(3, 1,2) ) THEN 
    86          CALL ctl_stop('dyn_hpg: requested workspace arrays are unavailable')   ;   RETURN 
    87       ENDIF 
     82      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
     83      !!---------------------------------------------------------------------- 
    8884      ! 
    8985      IF( l_trddyn ) THEN                    ! Temporary saving of ua and va trends (l_trddyn) 
     86         ztrdu => tsa(:,:,:,1)  
     87         ztrdv => tsa(:,:,:,2)  
     88         ! 
    9089         ztrdu(:,:,:) = ua(:,:,:)   
    9190         ztrdv(:,:,:) = va(:,:,:)  
    … …  
    110109      IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' hpg  - Ua: ', mask1=umask,   & 
    111110         &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    112       ! 
    113       IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_hpg: failed to release workspace arrays') 
    114111      ! 
    115112   END SUBROUTINE dyn_hpg 
    … …  
    193190      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    194191      !!---------------------------------------------------------------------- 
    195       USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
     192      USE oce, ONLY:   tsa                         ! (tsa) used as 2 3D workspace 
    196193      !! 
    197194      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    199196      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
    200197      REAL(wp) ::   zcoef0, zcoef1   ! temporary scalars 
     198      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
    201199      !!---------------------------------------------------------------------- 
    202200       
     201      zhpi => tsa(:,:,:,1)  
     202      zhpj => tsa(:,:,:,2)  
     203      ! 
    203204      IF( kt == nit000 ) THEN 
    204205         IF(lwp) WRITE(numout,*) 
    … …  
    221222         END DO 
    222223      END DO 
     224 
    223225      ! 
    224226      ! interior value (2=<jk=<jpkm1) 
    … …  
    253255      !! ** Action  : - Update (ua,va) with the now hydrastatic pressure trend 
    254256      !!----------------------------------------------------------------------  
    255       USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
     257      USE oce, ONLY:   tsa                         ! (tsa) used as 2 3D workspace 
    256258      !! 
    257259      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    260262      INTEGER  ::   iku, ikv                         ! temporary integers 
    261263      REAL(wp) ::   zcoef0, zcoef1, zcoef2, zcoef3   ! temporary scalars 
    262       !!---------------------------------------------------------------------- 
    263  
     264      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
     265      !!---------------------------------------------------------------------- 
     266        
     267      zhpi => tsa(:,:,:,1)  
     268      zhpj => tsa(:,:,:,2)  
     269      ! 
    264270      IF( kt == nit000 ) THEN 
    265271         IF(lwp) WRITE(numout,*) 
    … …  
    267273         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~   z-coordinate with partial steps - vector optimization' 
    268274      ENDIF 
     275 
    269276 
    270277      ! Local constant initialization 
    … …  
    284291      END DO 
    285292 
     293 
    286294      ! interior value (2=<jk=<jpkm1) 
    287295      DO jk = 2, jpkm1 
    … …  
    303311         END DO 
    304312      END DO 
     313 
    305314 
    306315      ! partial steps correction at the last level  (use gru & grv computed in zpshde.F90) 
    … …  
    333342      END DO 
    334343      ! 
     344 
    335345   END SUBROUTINE hpg_zps 
    336346 
    … …  
    354364      !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    355365      !!---------------------------------------------------------------------- 
    356       USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
     366      USE oce, ONLY:   tsa                         ! (tsa) used as 2 3D workspace 
    357367      !! 
    358368      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    360370      INTEGER  ::   ji, jj, jk                 ! dummy loop indices 
    361371      REAL(wp) ::   zcoef0, zuap, zvap, znad   ! temporary scalars 
    362       !!---------------------------------------------------------------------- 
    363  
     372      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
     373      !!---------------------------------------------------------------------- 
     374 
     375      zhpi => tsa(:,:,:,1)  
     376      zhpj => tsa(:,:,:,2)  
     377      ! 
    364378      IF( kt == nit000 ) THEN 
    365379         IF(lwp) WRITE(numout,*) 
    … …  
    439453      !!             - Save the trend (l_trddyn=T) 
    440454      !!---------------------------------------------------------------------- 
    441       USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
     455      USE oce, ONLY:   tsa                         ! (tsa) used as 2 3D workspace 
    442456      !! 
    443457      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    445459      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    446460      REAL(wp) ::   zcoef0, zuap, zvap   ! temporary scalars 
    447       !!---------------------------------------------------------------------- 
    448  
     461      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
     462      !!---------------------------------------------------------------------- 
     463 
     464      zhpi => tsa(:,:,:,1)  
     465      zhpj => tsa(:,:,:,2)  
     466      ! 
    449467      IF( kt == nit000 ) THEN 
    450468         IF(lwp) WRITE(numout,*) 
    … …  
    515533      !! Reference : Song, Mon. Wea. Rev., 126, 3213-3230, 1998. 
    516534      !!---------------------------------------------------------------------- 
    517       USE oce, ONLY:   zhpi => ta , zhpj => sa   ! (ta,sa) used as 3D workspace 
     535      USE oce, ONLY:   tsa                         ! (tsa) used as 2 3D workspace 
    518536      !! 
    519537      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
    … …  
    522540      REAL(wp) ::   zcoef0, zuap, zvap   ! temporary scalars 
    523541      REAL(wp) ::   zalph , zbeta        !    "         " 
    524       !!---------------------------------------------------------------------- 
    525  
     542      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
     543      !!---------------------------------------------------------------------- 
     544      ! 
     545      zhpi => tsa(:,:,:,1)  
     546      zhpj => tsa(:,:,:,2)  
     547      ! 
    526548      IF( kt == nit000 ) THEN 
    527549         IF(lwp) WRITE(numout,*) 
    … …  
    595617      !!---------------------------------------------------------------------- 
    596618      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    597       USE oce     , ONLY:   zhpi  => ta        , zhpj => sa       ! (ta,sa) used as 3D workspace 
     619      USE oce     , ONLY:   tsa                         ! (tsa) used as 2 3D workspace 
    598620      USE wrk_nemo, ONLY:   drhox => wrk_3d_1  , dzx  => wrk_3d_2 
    599621      USE wrk_nemo, ONLY:   drhou => wrk_3d_3  , dzu  => wrk_3d_4 , rho_i => wrk_3d_5 
    … …  
    610632      REAL(wp) ::   z1_10, cffu, cffx   !    "         " 
    611633      REAL(wp) ::   z1_12, cffv, cffy   !    "         " 
     634      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
    612635      !!---------------------------------------------------------------------- 
    613636 
    … …  
    615638         CALL ctl_stop('dyn:hpg_djc: requested workspace arrays unavailable')   ;   RETURN 
    616639      ENDIF 
     640      ! 
     641      zhpi => tsa(:,:,:,1)  
     642      zhpj => tsa(:,:,:,2)  
    617643 
    618644      IF( kt == nit000 ) THEN 
    … …  
    826852      !!---------------------------------------------------------------------- 
    827853      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    828       USE oce     , ONLY:   zhpi    => ta       , zhpj    => sa       ! (ta,sa) used as 3D workspace 
     854      USE oce     , ONLY:   tsa                          ! (tsa) used as 2 3D workspace 
    829855      USE wrk_nemo, ONLY:   zdistr  => wrk_2d_1 , zsina   => wrk_2d_2 , zcosa  => wrk_2d_3 
    830856      USE wrk_nemo, ONLY:   zhpiorg => wrk_3d_1 , zhpirot => wrk_3d_2 
    … …  
    838864      REAL(wp) ::   zforg, zcoef0, zuap, zmskd1, zmskd1m   ! temporary scalar 
    839865      REAL(wp) ::   zfrot        , zvap, zmskd2, zmskd2m   !    "         " 
     866      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zhpi, zhpj  
    840867      !!---------------------------------------------------------------------- 
    841868 
    … …  
    844871         CALL ctl_stop('dyn:hpg_rot: requested workspace arrays unavailable')   ;   RETURN 
    845872      ENDIF 
     873      ! 
     874      zhpi => tsa(:,:,:,1)  
     875      zhpj => tsa(:,:,:,2)  
    846876 
    847877      IF( kt == nit000 ) THEN 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90

    r2777 r2789  
    5353      !!---------------------------------------------------------------------- 
    5454      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    55       USE oce     , ONLY:   ztrdu => ta       , ztrdv => sa   ! (ta,sa) used as 3D workspace    
     55      USE oce     , ONLY:   tsa             ! tsa used as 2 3D workspace 
    5656      USE wrk_nemo, ONLY:   zhke  => wrk_3d_1                 ! 3D workspace 
    5757      !! 
    … …  
    6060      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    6161      REAL(wp) ::   zu, zv       ! temporary scalars 
     62      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdu, ztrdv  
    6263      !!---------------------------------------------------------------------- 
    6364 
    … …  
    7374 
    7475      IF( l_trddyn ) THEN           ! Save ua and va trends 
     76         ztrdu => tsa(:,:,:,1)  
     77         ztrdv => tsa(:,:,:,2)  
     78         ! 
    7579         ztrdu(:,:,:) = ua(:,:,:)  
    7680         ztrdv(:,:,:) = va(:,:,:)  

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90

    r2715 r2789  
    8686      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    8787      USE wrk_nemo, ONLY:   zwk1 => wrk_3d_3 , zwk2 => wrk_3d_4   ! 3D workspace 
    88       USE oce     , ONLY:   zwk3 => ta       , zwk4 => sa         ! ta, sa used as 3D workspace    
     88      USE oce     , ONLY:   tsa             ! tsa used as 2 3D workspace 
    8989      ! 
    9090      INTEGER, INTENT( in ) ::   kt           ! ocean time-step index 
    9191      ! 
    9292      INTEGER ::   ji, jj, jk                 ! dummy loop indices 
     93      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwk3, zwk4 
    9394      !!---------------------------------------------------------------------- 
    9495 
    … …  
    9697         CALL ctl_stop('dyn_ldf_bilapg: requested workspace arrays unavailable')   ;   RETURN 
    9798      ENDIF 
    98  
     99      ! 
     100      zwk3 => tsa(:,:,:,1)  
     101      zwk4 => tsa(:,:,:,2)  
     102      ! 
    99103      IF( kt == nit000 ) THEN 
    100104         IF(lwp) WRITE(numout,*) 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r2779 r2789  
    9393      !!---------------------------------------------------------------------- 
    9494      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    95       USE oce     , ONLY:   ze3u_f => ta       , ze3v_f => sa       ! (ta,sa) used as 3D workspace 
     95      USE oce     , ONLY:   tsa             ! tsa used as 2 3D workspace 
    9696      USE wrk_nemo, ONLY:   zs_t   => wrk_2d_1 , zs_u_1 => wrk_2d_2 , zs_v_1 => wrk_2d_3 
    9797      ! 
    … …  
    105105      REAL(wp) ::   zve3a, zve3n, zve3b, zvf    !   -      - 
    106106      REAL(wp) ::   zec, zv_t_ij, zv_t_ip1j, zv_t_ijp1 
     107      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ze3u_f, ze3v_f  
    107108      !!---------------------------------------------------------------------- 
    108109 
    … …  
    110111         CALL ctl_stop('dyn_nxt: requested workspace arrays unavailable')   ;   RETURN 
    111112      ENDIF 
    112  
     113      ! 
     114      ze3u_f => tsa(:,:,:,1)  
     115      ze3v_f => tsa(:,:,:,2)  
     116      ! 
    113117      IF( kt == nit000 ) THEN 
    114118         IF(lwp) WRITE(numout,*) 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r2715 r2789  
    103103      !! References : Roullet and Madec 1999, JGR. 
    104104      !!--------------------------------------------------------------------- 
    105       USE oce, ONLY:   zub   => ta , zvb   => sa   ! (ta,sa) used as workspace 
     105      USE oce, ONLY:   tsa                 ! tsa used as 2 3D workspace 
    106106      !! 
    107107      INTEGER, INTENT(in   ) ::   kt       ! ocean time-step index 
    … …  
    110110      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    111111      REAL(wp) ::   z2dt, z2dtg, zgcb, zbtd, ztdgu, ztdgv   ! local scalars 
     112      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zub, zvb 
    112113      !!---------------------------------------------------------------------- 
     114      ! 
     115      zub => tsa(:,:,:,1)  
     116      zvb => tsa(:,:,:,2)  
    113117      ! 
    114118      IF( kt == nit000 ) THEN 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90

    r2715 r2789  
    7171      !!               and planetary vorticity trends) ('key_trddyn') 
    7272      !!---------------------------------------------------------------------- 
    73       USE oce, ONLY:   ztrdu => ta , ztrdv => sa   ! (ta,sa) used as 3D workspace 
    74       ! 
     73      USE oce, ONLY:   tsa            ! tsa used as 2 3D workspace 
     74      !! 
    7575      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    76       !!---------------------------------------------------------------------- 
     76      ! 
     77      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
     78      !!---------------------------------------------------------------------- 
     79      ! 
     80      IF( l_trddyn )   THEN 
     81         ztrdu => tsa(:,:,:,1)  
     82         ztrdv => tsa(:,:,:,2)  
     83      END IF 
    7784      ! 
    7885      !                                          ! vorticity term  

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    r2715 r2789  
    5252      !! ** Action  : - Update (ua,va) with the vert. momentum adv. trends 
    5353      !!              - Save the trends in (ztrdu,ztrdv) ('key_trddyn') 
    54      !!---------------------------------------------------------------------- 
    55       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     54      !!---------------------------------------------------------------------- 
     55      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    5656      USE wrk_nemo, ONLY:   zww   => wrk_2d_1                        ! 2D workspace 
    57       USE oce     , ONLY:   zwuw  => ta       , zwvw  => sa          ! (ta,sa) used as 3D workspace 
     57      USE oce     , ONLY:   tsa             ! tsa used as 2 3D workspace 
    5858      USE wrk_nemo, ONLY:   ztrdu => wrk_3d_1 , ztrdv => wrk_3d_2    ! 3D workspace 
    59       ! 
     59      !! 
    6060      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
    6161      ! 
    6262      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
    6363      REAL(wp) ::   zua, zva        ! temporary scalars 
     64      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwuw , zwvw 
    6465      !!---------------------------------------------------------------------- 
    6566       
    66       IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1,2) ) THEN 
     67      IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1,2) ) THEN  
    6768         CALL ctl_stop('dyn_zad: requested workspace arrays unavailable')   ;   RETURN 
    6869      ENDIF 
    69  
     70      ! 
     71      zwuw  => tsa(:,:,:,1)  
     72      zwvw  => tsa(:,:,:,2)  
     73      ! 
    7074      IF( kt == nit000 ) THEN 
    7175         IF(lwp)WRITE(numout,*) 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_exp.F90

    r2715 r2789  
    5555      !!--------------------------------------------------------------------- 
    5656      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    57       USE oce     , ONLY:   zwx => ta       , zwy => sa         ! (ta,sa) used as 3D workspace 
    58       USE wrk_nemo, ONLY:   zwz => wrk_3d_1 , zww => wrk_3d_2   ! 3D workspace 
     57      USE oce     , ONLY:   tsa             ! tsa used as 2 3D workspace 
     58      USE wrk_nemo, ONLY:   zwz => wrk_3d_3 , zww => wrk_3d_4   ! 3D workspace 
    5959      ! 
    6060      INTEGER , INTENT(in) ::   kt     ! ocean time-step index 
    … …  
    6363      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    6464      REAL(wp) ::   zrau0r, zlavmr, zua, zva   ! local scalars 
     65      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwx, zwy 
    6566      !!---------------------------------------------------------------------- 
    6667 
    67       IF( wrk_in_use(3, 1,2) ) THEN 
     68      IF( wrk_in_use(3, 3,4) ) THEN 
    6869         CALL ctl_stop('dyn_zdf_exp: requested workspace arrays unavailable')   ;   RETURN 
    6970      ENDIF 
    70  
     71      ! 
     72      zwx => tsa(:,:,:,1)  
     73      zwy => tsa(:,:,:,2)  
     74      ! 
    7175      IF( kt == nit000 .AND. lwp ) THEN 
    7276         WRITE(numout,*) 
    … …  
    120124      END DO                           ! End of time splitting 
    121125      ! 
    122       IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('dyn_zdf_exp: failed to release workspace arrays') 
     126      IF( wrk_not_released(3, 3,4) )   CALL ctl_stop('dyn_zdf_exp: failed to release workspace arrays') 
    123127      ! 
    124128   END SUBROUTINE dyn_zdf_exp 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf_imp.F90

    r2715 r2789  
    5555      !!--------------------------------------------------------------------- 
    5656      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    57       USE oce     , ONLY:  zwd  => ta       , zws   => sa   ! (ta,sa) used as 3D workspace 
     57      USE oce     , ONLY:   tsa             ! tsa used as 2 3D workspace 
    5858      USE wrk_nemo, ONLY:   zwi => wrk_3d_3                 ! 3D workspace 
    5959      !! 
    … …  
    6363      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    6464      REAL(wp) ::   z1_p2dt, zcoef, zzwi, zzws, zrhs   ! local scalars 
     65      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zwd, zws 
    6566      !!---------------------------------------------------------------------- 
    6667 
    … …  
    6869         CALL ctl_stop('dyn_zdf_imp: requested workspace array unavailable')   ;   RETURN 
    6970      END IF 
    70  
     71      ! 
     72      zwd => tsa(:,:,:,1)  
     73      zws => tsa(:,:,:,2)  
     74      ! 
    7175      IF( kt == nit000 ) THEN 
    7276         IF(lwp) WRITE(numout,*) 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r2715 r2789  
    7575      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling. 
    7676      !!---------------------------------------------------------------------- 
    77       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    78       USE oce     , ONLY:   z3d   => ta                           ! ta used as 3D workspace 
    79       USE wrk_nemo, ONLY:   zhdiv => wrk_2d_1 , z2d => wrk_2d_2   ! 2D workspace 
    80       ! 
     77      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
     78      USE oce     , ONLY: tsa             ! tsa used as 2 3D workspace 
     79      USE wrk_nemo, ONLY: zhdiv => wrk_2d_1, z2d => wrk_2d_2 
     80      !! 
    8181      INTEGER, INTENT(in) ::   kt   ! time step 
    8282      ! 
    8383      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    8484      REAL(wp) ::   zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0   ! local scalars 
     85      REAL(wp), POINTER, DIMENSION(:,:,:) ::  z3d 
    8586      !!---------------------------------------------------------------------- 
    8687 
    … …  
    230231      IF( lk_diaar5 ) THEN                            ! vertical mass transport & its square value 
    231232         ! Caution: in the VVL case, it only correponds to the baroclinic mass transport. 
     233         z3d => tsa(:,:,:,1) 
    232234         z2d(:,:) = rau0 * e1t(:,:) * e2t(:,:) 
    233235         DO jk = 1, jpk 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/FLO/flowri.F90

    r2715 r2789  
    127127                  ! Change  by Alexandra Bozec et Jean-Philippe Boulanger 
    128128                  ! We save  the instantaneous profile of T and S of the column      
    129                   ! ztemp(jfl)=tn(iafloc,ibfloc,icfl) 
    130                   ! zsal(jfl)=sn(iafloc,ibfloc,icfl) 
    131                   ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 
    132                   zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk)             
     129                  ! ztemp(jfl)=tsn(iafloc,ibfloc,icfl,jp_tem) 
     130                  ! zsal(jfl)=tsn(iafloc,ibfloc,icfl,jp_sal) 
     131                  ztemp(1:jpk,jfl) = tsn(iafloc,ibfloc,1:jpk,jp_tem) 
     132                  zsal (1:jpk,jfl) = tsn(iafloc,ibfloc,1:jpk,jp_sal)             
    133133               ELSE 
    134134                  flxx(jfl) = 0. 
    … …  
    187187               ! Change  by Alexandra Bozec et Jean-Philippe Boulanger 
    188188               ! We save  the instantaneous profile of T and S of the column      
    189                !     ztemp(jfl)=tn(iafloc,ibfloc,icfl) 
    190                !     zsal(jfl)=sn(iafloc,ibfloc,icfl) 
    191                ztemp(1:jpk,jfl) = tn(iafloc,ibfloc,1:jpk) 
    192                zsal (1:jpk,jfl) = sn(iafloc,ibfloc,1:jpk) 
     189               !     ztemp(jfl)=tsn(iafloc,ibfloc,icfl,jp_tem) 
     190               !     zsal(jfl)=tsn(iafloc,ibfloc,icfl,jp_sal) 
     191               ztemp(1:jpk,jfl) = tsn(iafloc,ibfloc,1:jpk,jp_tem) 
     192               zsal (1:jpk,jfl) = tsn(iafloc,ibfloc,1:jpk,jp_sal) 
    193193            END DO 
    194194         ENDIF 
    … …  
    224224      !         ibfloc=ibfln 
    225225      !# endif 
    226       !         ztemp(jfl)=tn(iafloc,ibfloc,jk) 
    227       !         zsal(jfl)=sn(iaflo!,ibfloc,jk) 
     226      !         ztemp(jfl)=tsn(iafloc,ibfloc,jk,jp_tem) 
     227      !         zsal(jfl)=tsn(iaflo!,ibfloc,jk,jp_sal) 
    228228      !# if defined key_mpp_mpi    
    229229      !        ELSE 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r2528 r2789  
    2424   USE trdmld_oce      ! ocean active mixed layer tracers trends variables 
    2525   USE domvvl          ! variable volume 
    26    USE traswp          ! swap from 4D T-S to 3D T & S and vice versa 
    2726 
    2827   IMPLICIT NONE 
    … …  
    117116                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub        )     ! before fields 
    118117                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb        ) 
    119                      CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tb        ) 
    120                      CALL iom_rstput( kt, nitrst, numrow, 'sb'     , sb        ) 
     118                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem) ) 
     119                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal) ) 
    121120                     CALL iom_rstput( kt, nitrst, numrow, 'rotb'   , rotb      ) 
    122121                     CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb     ) 
    … …  
    126125                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , un        )     ! now fields 
    127126                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn        ) 
    128                      CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tn        ) 
    129                      CALL iom_rstput( kt, nitrst, numrow, 'sn'     , sn        ) 
     127                     CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem) ) 
     128                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal) ) 
    130129                     CALL iom_rstput( kt, nitrst, numrow, 'rotn'   , rotn      ) 
    131130                     CALL iom_rstput( kt, nitrst, numrow, 'hdivn'  , hdivn     ) 
    … …  
    186185                     CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub      )   ! before fields 
    187186                     CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb      ) 
    188                      CALL iom_get( numror, jpdom_autoglo, 'tb'     , tb      ) 
    189                      CALL iom_get( numror, jpdom_autoglo, 'sb'     , sb      ) 
     187                     CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem) ) 
     188                     CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal) ) 
    190189                     CALL iom_get( numror, jpdom_autoglo, 'rotb'   , rotb    ) 
    191190                     CALL iom_get( numror, jpdom_autoglo, 'hdivb'  , hdivb   ) 
    … …  
    195194                     CALL iom_get( numror, jpdom_autoglo, 'un'     , un      )   ! now    fields 
    196195                     CALL iom_get( numror, jpdom_autoglo, 'vn'     , vn      ) 
    197                      CALL iom_get( numror, jpdom_autoglo, 'tn'     , tn      ) 
    198                      CALL iom_get( numror, jpdom_autoglo, 'sn'     , sn      ) 
     196                     CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,:,jp_tem) ) 
     197                     CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal) ) 
    199198                     CALL iom_get( numror, jpdom_autoglo, 'rotn'   , rotn    ) 
    200199                     CALL iom_get( numror, jpdom_autoglo, 'hdivn'  , hdivn   ) 
    … …  
    205204                     CALL iom_get( numror, jpdom_autoglo, 'rhd'    , rhd     )   ! now    in situ density anomaly 
    206205      ELSE 
    207                      CALL tra_swap 
    208206                     CALL eos( tsn, rhd )   ! compute rhd 
    209207      ENDIF 
    … …  
    211209      ! 
    212210      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0) 
    213          tb   (:,:,:) = tn   (:,:,:)                             ! all before fields set to now values 
    214          sb   (:,:,:) = sn   (:,:,:) 
    215          ub   (:,:,:) = un   (:,:,:) 
    216          vb   (:,:,:) = vn   (:,:,:) 
    217          rotb (:,:,:) = rotn (:,:,:) 
    218          hdivb(:,:,:) = hdivn(:,:,:) 
    219          sshb (:,:)   = sshn (:,:) 
     211         tsb  (:,:,:,:) = tsn  (:,:,:,:)                             ! all before fields set to now values 
     212         ub   (:,:,:)   = un   (:,:,:) 
     213         vb   (:,:,:)   = vn   (:,:,:) 
     214         rotb (:,:,:)   = rotn (:,:,:) 
     215         hdivb(:,:,:)   = hdivn(:,:,:) 
     216         sshb (:,:)     = sshn (:,:) 
    220217         IF( lk_vvl ) THEN 
    221218            DO jk = 1, jpk 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/LBC/cla.F90

    r2715 r2789  
    387387            DO ji = mi0(161), mi1(161)  
    388388               DO jk = 1, jpkm1                         ! surf inflow + reciculation (from Gulf of Aden) 
    389                   ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_161_88_kt(jk) * tn(ji,jj,jk) 
    390                   sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_161_88_kt(jk) * sn(ji,jj,jk) 
     389                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_161_88_kt(jk) * tsn(ji,jj,jk,jp_tem) 
     390                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_161_88_kt(jk) * tsn(ji,jj,jk,jp_sal) 
    391391               END DO 
    392392            END DO 
    … …  
    395395            DO ji = mi0(161), mi1(161)  
    396396               jk =  21                                 ! deep outflow + recirulation (combined flux) 
    397                ta(ji,jj,jk) = ta(ji,jj,jk) + hdiv_161_88(20) * tn(ji  ,jj+1,20)   &  ! upper recirculation from Gulf of Aden 
    398                   &                        + hdiv_161_88(21) * tn(ji  ,jj+1,21)   &  ! deep  recirculation from Gulf of Aden 
    399                   &                        + hdiv_160_89(16) * tn(ji-1,jj+2,16)      ! deep inflow from Red sea 
    400                sa(ji,jj,jk) = sa(ji,jj,jk) + hdiv_161_88(20) * sn(ji  ,jj+1,20)   & 
    401                   &                        + hdiv_161_88(21) * sn(ji  ,jj+1,21)   & 
    402                   &                        + hdiv_160_89(16) * sn(ji-1,jj+2,16)    
     397               tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + hdiv_161_88(20) * tsn(ji  ,jj+1,20,jp_tem)   &  ! upper recirculation from Gulf of Aden 
     398                  &                        + hdiv_161_88(21) * tsn(ji  ,jj+1,21,jp_tem)   &  ! deep  recirculation from Gulf of Aden 
     399                  &                        + hdiv_160_89(16) * tsn(ji-1,jj+2,16,jp_tem)      ! deep inflow from Red sea 
     400               tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + hdiv_161_88(20) * tsn(ji  ,jj+1,20,jp_sal)   & 
     401                  &                        + hdiv_161_88(21) * tsn(ji  ,jj+1,21,jp_sal)   & 
     402                  &                        + hdiv_160_89(16) * tsn(ji-1,jj+2,16,jp_sal)    
    403403            END DO 
    404404         END DO 
    … …  
    406406            DO ji = mi0(160), mi1(160) 
    407407               DO jk = 1, 14                            ! surface inflow (from Gulf of Aden) 
    408                   ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_160_89_kt(jk) * tn(ji+1,jj-1,jk) 
    409                   sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_160_89_kt(jk) * sn(ji+1,jj-1,jk) 
    410                END DO 
    411                !                                        ! deep    outflow (from Red sea) 
    412                ta(ji,jj,16) = ta(ji,jj,16) - hdiv_160_89(jk) * tn(ji,jj,jk) 
    413                sa(ji,jj,16) = sa(ji,jj,16) - hdiv_160_89(jk) * sn(ji,jj,jk) 
     408                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_160_89_kt(jk) * tsn(ji+1,jj-1,jk,jp_tem) 
     409                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_160_89_kt(jk) * tsn(ji+1,jj-1,jk,jp_sal) 
     410               END DO 
     411               !                                  ! deep    outflow (from Red sea) 
     412               tsa(ji,jj,16,jp_tem) = tsa(ji,jj,16,jp_tem) - hdiv_160_89(16) * tsn(ji,jj,16,jp_tem) 
     413               tsa(ji,jj,16,jp_sal) = tsa(ji,jj,16,jp_sal) - hdiv_160_89(16) * tsn(ji,jj,16,jp_sal) 
    414414            END DO 
    415415         END DO 
    … …  
    577577            DO ji = mi0(139), mi1(139)  
    578578               DO jk = 1, jpkm1                         ! surf inflow + mid. & bottom reciculation (from Atlantic)    
    579                   ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_139_101_kt(jk) * tn(ji,jj,jk) 
    580                   sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_139_101_kt(jk) * sn(ji,jj,jk) 
     579                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_139_101_kt(jk) * tsn(ji,jj,jk,jp_tem) 
     580                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_139_101_kt(jk) * tsn(ji,jj,jk,jp_sal) 
    581581               END DO 
    582582            END DO 
    … …  
    586586            DO ji = mi0(139), mi1(139)  
    587587               DO jk = 15, 20                            ! middle  reciculation (Atl 101 -> Atl 102)   (div <0) 
    588                   ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_139_102(jk) * tn(ji,jj-1,jk)  ! middle Atlantic recirculation 
    589                   sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_139_102(jk) * sn(ji,jj-1,jk) 
     588                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_139_102(jk) * tsn(ji,jj-1,jk,jp_tem)  ! middle Atlantic recirculation 
     589                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_139_102(jk) * tsn(ji,jj-1,jk,jp_sal) 
    590590               END DO 
    591591               !                                         ! upper & bottom Atl. reciculation (Atl 101 -> Atl 102) - (div <0) 
    592592               !                                         ! deep Med flow                    (Med 102 -> Atl 102) - (div <0) 
    593                ta(ji,jj,22) = ta(ji,jj,22) + hdiv_141_102(21) * tn(ji+2,jj  ,21)   &  ! deep Med flow   
    594                   &                        + hdiv_139_101(21) * tn(ji  ,jj-1,21)   &  ! upper  Atlantic recirculation   
    595                   &                        + hdiv_139_101(22) * tn(ji  ,jj-1,22)      ! bottom Atlantic recirculation   
    596                sa(ji,jj,22) = sa(ji,jj,22) + hdiv_141_102(21) * sn(ji+2,jj  ,21)   & 
    597                   &                        + hdiv_139_101(21) * sn(ji  ,jj-1,21)   & 
    598                   &                        + hdiv_139_101(22) * sn(ji  ,jj-1,22)  
     593               tsa(ji,jj,22,jp_tem) = tsa(ji,jj,22,jp_tem) + hdiv_141_102(21) * tsn(ji+2,jj,21,jp_tem)   &  ! deep Med flow   
     594                  &                        + hdiv_139_101(21) * tsn(ji,jj-1,21,jp_tem)   &  ! upper  Atlantic recirculation   
     595                  &                        + hdiv_139_101(22) * tsn(ji,jj-1,22,jp_tem)      ! bottom Atlantic recirculation   
     596               tsa(ji,jj,22,jp_sal) = tsa(ji,jj,22,jp_sal) + hdiv_141_102(21) * tsn(ji+2,jj,21,jp_sal)   & 
     597                  &                        + hdiv_139_101(21) * tsn(ji,jj-1,21,jp_sal)   & 
     598                  &                        + hdiv_139_101(22) * tsn(ji,jj-1,22,jp_sal)  
    599599            END DO 
    600600         END DO 
    … …  
    602602            DO ji = mi0(141), mi1(141)  
    603603               DO jk = 1, 14                             ! surface flow from Atlantic to Med sea 
    604                   ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_141_102_kt(jk) * tn(ji-2,jj-1,jk) 
    605                   sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_141_102_kt(jk) * sn(ji-2,jj-1,jk) 
     604                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_141_102_kt(jk) * tsn(ji-2,jj-1,jk,jp_tem) 
     605                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_141_102_kt(jk) * tsn(ji-2,jj-1,jk,jp_sal) 
    606606               END DO 
    607607               !                                         ! deeper flow from Med sea to Atlantic 
    608                ta(ji,jj,21) = ta(ji,jj,21) - hdiv_141_102(21) * tn(ji,jj,21) 
    609                sa(ji,jj,21) = sa(ji,jj,21) - hdiv_141_102(21) * sn(ji,jj,21) 
     608               tsa(ji,jj,21,jp_tem) = tsa(ji,jj,21,jp_tem) - hdiv_141_102(21) * tsn(ji,jj,21,jp_tem) 
     609               tsa(ji,jj,21,jp_sal) = tsa(ji,jj,21,jp_sal) - hdiv_141_102(21) * tsn(ji,jj,21,jp_sal) 
    610610            END DO 
    611611         END DO 
    … …  
    707707            DO ji = mi0(172), mi1(172)  
    708708               DO jk = 1, 8                          ! surface inflow   (Indian ocean to Persian Gulf) (div<0) 
    709                   ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_172_94(jk) * tn(ji,jj,jk)  
    710                   sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_172_94(jk) * sn(ji,jj,jk)  
     709                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_172_94(jk) * tsn(ji,jj,jk,jp_tem)  
     710                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_172_94(jk) * tsn(ji,jj,jk,jp_sal)  
    711711               END DO 
    712712               DO jk = 16, 18                        ! deep outflow     (Persian Gulf to Indian ocean) (div>0) 
    713                   ta(ji,jj,jk) = ta(ji,jj,jk) - hdiv_172_94(jk) * t_171_94_hor(jk) 
    714                   sa(ji,jj,jk) = sa(ji,jj,jk) - hdiv_172_94(jk) * s_171_94_hor(jk) 
     713                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) - hdiv_172_94(jk) * t_171_94_hor(jk) 
     714                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) - hdiv_172_94(jk) * s_171_94_hor(jk) 
    715715               END DO 
    716716            END DO 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r2772 r2789  
    116116      !!---------------------------------------------------------------------- 
    117117      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    118       USE oce     , ONLY:   zgru => ua       , zww => va   ! (ua,va) used as workspace 
    119       USE oce     , ONLY:   zgrv => ta       , zwz => sa   ! (ta,sa) used as workspace 
    120       USE wrk_nemo, ONLY:   zdzr => wrk_3d_1               ! 3D workspace 
     118      USE oce     , ONLY:   zwz => ua       , zww => va   ! (ua,va) used as workspace 
     119      USE oce     , ONLY:   tsa                           ! (tsa) used as workspace 
     120      USE wrk_nemo, ONLY:   zdzr => wrk_3d_1              ! 3D workspace 
    121121      !! 
    122122      INTEGER , INTENT(in)                   ::   kt    ! ocean time-step index 
    … …  
    131131      REAL(wp) ::   zcj, zfj, zav, zbv, zaj, zbj   !   -      - 
    132132      REAL(wp) ::   zck, zfk,      zbw             !   -      - 
     133      REAL(wp), POINTER, DIMENSION(:,:,:) ::  zgru, zgrv 
    133134      !!---------------------------------------------------------------------- 
    134135 
    … …  
    136137         CALL ctl_stop('ldf_slp: requested workspace arrays are unavailable')   ;   RETURN 
    137138      ENDIF 
     139      ! 
     140      zgru => tsa(:,:,:,1) 
     141      zgrv => tsa(:,:,:,2) 
    138142 
    139143      zeps   =  1.e-20_wp        !==   Local constant initialization   ==! 
    … …  
    379383      ENDIF 
    380384      ! 
    381       IF( wrk_not_released(3, 1) )   CALL ctl_stop('ldf_slp: failed to release workspace arrays') 
     385      IF( wrk_not_released(3, 1) )  CALL ctl_stop('ldf_slp: failed to release workspace arrays.') 
    382386      ! 
    383387   END SUBROUTINE ldf_slp 
    … …  
    399403      !!---------------------------------------------------------------------- 
    400404      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    401       USE oce     , ONLY:   zdit    => ua       , zdis   => va         ! (ua,va) used as workspace 
    402       USE oce     , ONLY:   zdjt    => ta       , zdjs   => sa         ! (ta,sa) used as workspace 
    403       USE wrk_nemo, ONLY:   zdkt    => wrk_3d_2 , zdks   => wrk_3d_3   ! 3D workspace 
    404       USE wrk_nemo, ONLY:   zalpha  => wrk_3d_4 , zbeta => wrk_3d_5    ! alpha, beta at T points, at depth fsgdept 
    405405      USE wrk_nemo, ONLY:   z1_mlbw => wrk_2d_1 
    406       ! 
    407       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    408       ! 
    409       INTEGER  ::   ji, jj, jk, jl, ip, jp, kp  ! dummy loop indices 
     406      USE wrk_nemo, ONLY:   zalpha  => wrk_3d_2 , zbeta => wrk_3d_3    ! alpha, beta at T points, at depth fsgdept 
     407      USE wrk_nemo, ONLY:   zdits   => wrk_4d_1 , zdjts => wrk_4d_2, zdkts => wrk_4d_3   ! 4D workspace 
     408      !! 
     409      INTEGER, INTENT( in ) ::   kt         ! ocean time-step index 
     410      !! 
     411      INTEGER  ::   ji, jj, jk, jn, jl, ip, jp, kp  ! dummy loop indices 
    410412      INTEGER  ::   iku, ikv                                  ! local integer 
    411413      REAL(wp) ::   zfacti, zfactj, zatempw,zatempu,zatempv   ! local scalars 
    … …  
    416418      !!---------------------------------------------------------------------- 
    417419 
    418       IF( wrk_in_use(3, 2,3,4,5) .OR. wrk_in_use(2, 1) )THEN 
    419          CALL ctl_stop('ldf_slp_grif: requested workspace arrays are unavailable')   ;   RETURN 
    420       ENDIF 
    421  
     420      IF( wrk_in_use(4, 1,2,3) .OR. wrk_in_use(3, 2,3) .OR. wrk_in_use(2, 1) ) THEN 
     421         CALL ctl_stop('ldf_slp_grif: ERROR: requested workspace arrays are unavailable.')   ;   RETURN 
     422      END IF 
     423      ! 
    422424      !--------------------------------! 
    423425      !  Some preliminary calculation  ! 
    … …  
    426428      CALL eos_alpbet( tsb, zalpha, zbeta )     !==  before thermal and haline expension coeff. at T-points  ==! 
    427429      ! 
    428       DO jk = 1, jpkm1                          !==  before lateral T & S gradients at T-level jk  ==! 
    429          DO jj = 1, jpjm1 
    430             DO ji = 1, fs_jpim1   ! vector opt. 
    431                zdit(ji,jj,jk) = ( tb(ji+1,jj,jk) - tb(ji,jj,jk) ) * umask(ji,jj,jk)   ! i-gradient of T and S at jj 
    432                zdis(ji,jj,jk) = ( sb(ji+1,jj,jk) - sb(ji,jj,jk) ) * umask(ji,jj,jk) 
    433                zdjt(ji,jj,jk) = ( tb(ji,jj+1,jk) - tb(ji,jj,jk) ) * vmask(ji,jj,jk)   ! j-gradient of T and S at jj 
    434                zdjs(ji,jj,jk) = ( sb(ji,jj+1,jk) - sb(ji,jj,jk) ) * vmask(ji,jj,jk) 
    435             END DO 
    436          END DO 
    437       END DO 
    438       IF( ln_zps ) THEN                               ! partial steps: correction at the last level 
     430      DO jn = 1, jpts 
     431         DO jk = 1, jpkm1                          !==  before lateral T & S gradients at T-level jk  ==! 
     432            DO jj = 1, jpjm1 
     433               DO ji = 1, fs_jpim1   ! vector opt. 
     434                  zdits(ji,jj,jk,jn) = ( tsb(ji+1,jj,jk,jn) - tsb(ji,jj,jk,jn) ) * umask(ji,jj,jk)   ! i-gradient of T and S at jj 
     435                  zdjts(ji,jj,jk,jn) = ( tsb(ji,jj+1,jk,jn) - tsb(ji,jj,jk,jn) ) * vmask(ji,jj,jk)   ! j-gradient of T and S at jj 
     436               END DO 
     437            END DO 
     438         END DO 
     439         IF( ln_zps ) THEN                               ! partial steps: correction at the last level 
    439440# if defined key_vectopt_loop 
    440          DO jj = 1, 1 
    441             DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
     441            DO jj = 1, 1 
     442               DO ji = 1, jpij-jpi   ! vector opt. (forced unrolling) 
    442443# else 
    443          DO jj = 1, jpjm1 
    444             DO ji = 1, jpim1 
     444            DO jj = 1, jpjm1 
     445               DO ji = 1, jpim1 
    445446# endif 
    446                zdit(ji,jj,mbku(ji,jj)) = gtsu(ji,jj,jp_tem)                           ! i-gradient of T and S 
    447                zdis(ji,jj,mbku(ji,jj)) = gtsu(ji,jj,jp_sal) 
    448                zdjt(ji,jj,mbkv(ji,jj)) = gtsv(ji,jj,jp_tem)                           ! j-gradient of T and S 
    449                zdjs(ji,jj,mbkv(ji,jj)) = gtsv(ji,jj,jp_sal) 
    450             END DO 
    451          END DO 
    452       ENDIF 
    453       ! 
    454       zdkt(:,:,1) = 0._wp                    !==  before vertical T & S gradient at w-level  ==! 
    455       zdks(:,:,1) = 0._wp 
    456       DO jk = 2, jpk 
    457          zdkt(:,:,jk) = ( tb(:,:,jk-1) - tb(:,:,jk) ) * tmask(:,:,jk) 
    458          zdks(:,:,jk) = ( sb(:,:,jk-1) - sb(:,:,jk) ) * tmask(:,:,jk) 
    459       END DO 
    460       ! 
     447                  zdits(ji,jj,mbku(ji,jj),jn) = gtsu(ji,jj,jn)                           ! i-gradient of T and S 
     448                  zdjts(ji,jj,mbkv(ji,jj),jn) = gtsv(ji,jj,jn)                           ! j-gradient of T and S 
     449               END DO 
     450            END DO 
     451         ENDIF 
     452         ! 
     453         zdkts(:,:,1,jn) = 0._wp                    !==  before vertical T & S gradient at w-level  ==! 
     454         DO jk = 2, jpk 
     455            zdkts(:,:,jk,jn) = ( tsb(:,:,jk-1,jn) - tsb(:,:,jk,jn) ) * tmask(:,:,jk) 
     456         END DO 
     457         ! 
     458      END DO  
    461459      ! 
    462460      DO jl = 0, 1                           !==  density i-, j-, and k-gradients  ==! 
    … …  
    465463            DO jj = 1, jpjm1                       ! NB: not masked due to the minimum value set 
    466464               DO ji = 1, fs_jpim1   ! vector opt.  
    467                   zdxrho_raw = ( zalpha(ji+ip,jj   ,jk) * zdit(ji,jj,jk) + zbeta(ji+ip,jj   ,jk) * zdis(ji,jj,jk) ) / e1u(ji,jj) 
    468                   zdyrho_raw = ( zalpha(ji   ,jj+jp,jk) * zdjt(ji,jj,jk) + zbeta(ji   ,jj+jp,jk) * zdjs(ji,jj,jk) ) / e2v(ji,jj) 
     465                  zdxrho_raw = ( zalpha(ji+ip,jj   ,jk) * zdits(ji,jj,jk,jp_tem) + zbeta(ji+ip,jj   ,jk) * zdits(ji,jj,jk,jp_sal) ) / e1u(ji,jj) 
     466                  zdyrho_raw = ( zalpha(ji   ,jj+jp,jk) * zdjts(ji,jj,jk,jp_tem) + zbeta(ji   ,jj+jp,jk) * zdjts(ji,jj,jk,jp_sal) ) / e2v(ji,jj) 
    469467                  zdxrho(ji+ip,jj   ,jk,1-ip) = SIGN( MAX(   repsln, ABS( zdxrho_raw ) ), zdxrho_raw )    ! keep the sign 
    470468                  zdyrho(ji   ,jj+jp,jk,1-jp) = SIGN( MAX(   repsln, ABS( zdyrho_raw ) ), zdyrho_raw ) 
    … …  
    477475            DO jj = 1, jpj                       ! NB: not masked due to the minimum value set 
    478476               DO ji = 1, jpi   ! vector opt.  
    479                   zdzrho_raw = ( zalpha(ji,jj,jk) * zdkt(ji,jj,jk+kp) + zbeta(ji,jj,jk) * zdks(ji,jj,jk+kp) )   & 
     477                  zdzrho_raw = ( zalpha(ji,jj,jk) * zdkts(ji,jj,jk+kp,jp_tem) + zbeta(ji,jj,jk) * zdkts(ji,jj,jk+kp,jp_sal) )   & 
    480478                     &       / fse3w(ji,jj,jk+kp) 
    481479                  zdzrho(ji   ,jj   ,jk,  kp) =     - MIN( - repsln,      zdzrho_raw )                    ! force zdzrho >= repsln 
    … …  
    600598      CALL lbc_lnk( wslp2, 'W', 1. )      ! lateral boundary confition on wslp2 only   ==>>> gm : necessary ? to be checked 
    601599      ! 
    602       IF( wrk_not_released(3, 2,3,4,5) .OR.   & 
    603           wrk_not_released(2, 1)       )   CALL ctl_stop('ldf_slp_grif: failed to release workspace arrays') 
     600      IF( wrk_not_released(4, 1,2,3) .OR.   & 
     601          wrk_not_released(3, 2,3  ) .OR.   & 
     602          wrk_not_released(2, 1    )        )   CALL ctl_stop('ldf_slp_grif: ERROR: failed to release workspace arrays.') 
    604603      ! 
    605604   END SUBROUTINE ldf_slp_grif 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90

    r2722 r2789  
    304304         IF (lp_obc_east) THEN  ! East 
    305305            DO ji = nie0 , nie1     
    306                sfoe(nje0:nje1,:) = temsk(nje0:nje1,:) * sn (ji+1 , nje0:nje1 , :) * tmask(ji+1,nje0:nje1 , :) 
    307                tfoe(nje0:nje1,:) = temsk(nje0:nje1,:) * tn (ji+1 , nje0:nje1 , :) * tmask(ji+1,nje0:nje1 , :) 
    308                ufoe(nje0:nje1,:) = uemsk(nje0:nje1,:) * un (ji   , nje0:nje1 , :) * umask(ji,  nje0:nje1 , :) 
    309                vfoe(nje0:nje1,:) = vemsk(nje0:nje1,:) * vn (ji+1 , nje0:nje1 , :) * vmask(ji+1,nje0:nje1 , :) 
     306               sfoe(nje0:nje1,:) = temsk(nje0:nje1,:) * tsn(ji+1 , nje0:nje1 , :,jp_sal) * tmask(ji+1,nje0:nje1 , :) 
     307               tfoe(nje0:nje1,:) = temsk(nje0:nje1,:) * tsn(ji+1 , nje0:nje1 , :,jp_tem) * tmask(ji+1,nje0:nje1 , :) 
     308               ufoe(nje0:nje1,:) = uemsk(nje0:nje1,:) * un (ji   , nje0:nje1 , :)        * umask(ji,  nje0:nje1 , :) 
     309               vfoe(nje0:nje1,:) = vemsk(nje0:nje1,:) * vn (ji+1 , nje0:nje1 , :)        * vmask(ji+1,nje0:nje1 , :) 
    310310            END DO 
    311311         ENDIF 
    … …  
    313313         IF (lp_obc_west) THEN  ! West 
    314314            DO ji = niw0 , niw1     
    315                sfow(njw0:njw1,:) = twmsk(njw0:njw1,:) * sn (ji , njw0:njw1 , :) * tmask(ji , njw0:njw1 , :) 
    316                tfow(njw0:njw1,:) = twmsk(njw0:njw1,:) * tn (ji , njw0:njw1 , :) * tmask(ji , njw0:njw1 , :) 
    317                ufow(njw0:njw1,:) = uwmsk(njw0:njw1,:) * un (ji , njw0:njw1 , :) * umask(ji , njw0:njw1 , :) 
    318                vfow(njw0:njw1,:) = vwmsk(njw0:njw1,:) * vn (ji , njw0:njw1 , :) * vmask(ji , njw0:njw1 , :) 
     315               sfow(njw0:njw1,:) = twmsk(njw0:njw1,:) * tsn(ji , njw0:njw1 , :,jp_sal) * tmask(ji , njw0:njw1 , :) 
     316               tfow(njw0:njw1,:) = twmsk(njw0:njw1,:) * tsn(ji , njw0:njw1 , :,jp_tem) * tmask(ji , njw0:njw1 , :) 
     317               ufow(njw0:njw1,:) = uwmsk(njw0:njw1,:) * un (ji , njw0:njw1 , :)        * umask(ji , njw0:njw1 , :) 
     318               vfow(njw0:njw1,:) = vwmsk(njw0:njw1,:) * vn (ji , njw0:njw1 , :)        * vmask(ji , njw0:njw1 , :) 
    319319            END DO 
    320320         ENDIF 
    … …  
    322322         IF (lp_obc_north) THEN ! North 
    323323            DO jj = njn0 , njn1 
    324                sfon(nin0:nin1,:) = tnmsk(nin0:nin1,:) * sn (nin0:nin1 , jj+1 , :) * tmask(nin0:nin1 , jj+1 , :) 
    325                tfon(nin0:nin1,:) = tnmsk(nin0:nin1,:) * tn (nin0:nin1 , jj+1 , :) * tmask(nin0:nin1 , jj+1 , :) 
    326                ufon(nin0:nin1,:) = unmsk(nin0:nin1,:) * un (nin0:nin1 , jj+1 , :) * umask(nin0:nin1 , jj+1 , :) 
    327                vfon(nin0:nin1,:) = vnmsk(nin0:nin1,:) * vn (nin0:nin1 , jj   , :) * vmask(nin0:nin1 , jj   , :) 
     324               sfon(nin0:nin1,:) = tnmsk(nin0:nin1,:) * tsn(nin0:nin1 , jj+1 , :,jp_sal) * tmask(nin0:nin1 , jj+1 , :) 
     325               tfon(nin0:nin1,:) = tnmsk(nin0:nin1,:) * tsn(nin0:nin1 , jj+1 , :,jp_tem) * tmask(nin0:nin1 , jj+1 , :) 
     326               ufon(nin0:nin1,:) = unmsk(nin0:nin1,:) * un (nin0:nin1 , jj+1 , :)        * umask(nin0:nin1 , jj+1 , :) 
     327               vfon(nin0:nin1,:) = vnmsk(nin0:nin1,:) * vn (nin0:nin1 , jj   , :)        * vmask(nin0:nin1 , jj   , :) 
    328328            END DO 
    329329         ENDIF 
    … …  
    331331         IF (lp_obc_south) THEN ! South 
    332332            DO jj = njs0 , njs1 
    333                sfos(nis0:nis1,:) = tsmsk(nis0:nis1,:) * sn (nis0:nis1 , jj , :) * tmask(nis0:nis1 , jj , :) 
    334                tfos(nis0:nis1,:) = tsmsk(nis0:nis1,:) * tn (nis0:nis1 , jj , :) * tmask(nis0:nis1 , jj , :) 
    335                ufos(nis0:nis1,:) = usmsk(nis0:nis1,:) * un (nis0:nis1 , jj , :) * umask(nis0:nis1 , jj , :) 
    336                vfos(nis0:nis1,:) = vsmsk(nis0:nis1,:) * vn (nis0:nis1 , jj , :) * vmask(nis0:nis1 , jj , :) 
     333               sfos(nis0:nis1,:) = tsmsk(nis0:nis1,:) * tsn(nis0:nis1 , jj , :,jp_sal) * tmask(nis0:nis1 , jj , :) 
     334               tfos(nis0:nis1,:) = tsmsk(nis0:nis1,:) * tsn(nis0:nis1 , jj , :,jp_tem) * tmask(nis0:nis1 , jj , :) 
     335               ufos(nis0:nis1,:) = usmsk(nis0:nis1,:) * un (nis0:nis1 , jj , :)        * umask(nis0:nis1 , jj , :) 
     336               vfos(nis0:nis1,:) = vsmsk(nis0:nis1,:) * vn (nis0:nis1 , jj , :)        * vmask(nis0:nis1 , jj , :) 
    337337            END DO 
    338338         ENDIF 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/OBC/obcrad.F90

    r2715 r2789  
    215215                  sebnd(jj,jk,nibm,nitm) = sebnd(jj,jk,nibm,nit)*temsk(jj,jk) 
    216216         ! ... fields nit <== now (kt+1) 
    217                   tebnd(jj,jk,nib  ,nit) = tn(ji  ,jj,jk)*temsk(jj,jk) 
    218                   tebnd(jj,jk,nibm ,nit) = tn(ji-1,jj,jk)*temsk(jj,jk) 
    219                   sebnd(jj,jk,nib  ,nit) = sn(ji  ,jj,jk)*temsk(jj,jk) 
    220                   sebnd(jj,jk,nibm ,nit) = sn(ji-1,jj,jk)*temsk(jj,jk) 
     217                  tebnd(jj,jk,nib  ,nit) = tsn(ji  ,jj,jk,jp_tem)*temsk(jj,jk) 
     218                  tebnd(jj,jk,nibm ,nit) = tsn(ji-1,jj,jk,jp_tem)*temsk(jj,jk) 
     219                  sebnd(jj,jk,nib  ,nit) = tsn(ji  ,jj,jk,jp_sal)*temsk(jj,jk) 
     220                  sebnd(jj,jk,nibm ,nit) = tsn(ji-1,jj,jk,jp_sal)*temsk(jj,jk) 
    221221               END DO 
    222222            END DO 
    … …  
    481481                  swbnd(jj,jk,nibm ,nitm) = swbnd(jj,jk,nibm ,nit)*twmsk(jj,jk) 
    482482         ! ... fields nit <== now (kt+1) 
    483                   twbnd(jj,jk,nib  ,nit) = tn(ji   ,jj,jk)*twmsk(jj,jk) 
    484                   twbnd(jj,jk,nibm ,nit) = tn(ji+1 ,jj,jk)*twmsk(jj,jk) 
    485                   swbnd(jj,jk,nib  ,nit) = sn(ji   ,jj,jk)*twmsk(jj,jk) 
    486                   swbnd(jj,jk,nibm ,nit) = sn(ji+1 ,jj,jk)*twmsk(jj,jk) 
     483                  twbnd(jj,jk,nib  ,nit) = tsn(ji   ,jj,jk,jp_tem)*twmsk(jj,jk) 
     484                  twbnd(jj,jk,nibm ,nit) = tsn(ji+1 ,jj,jk,jp_tem)*twmsk(jj,jk) 
     485                  swbnd(jj,jk,nib  ,nit) = tsn(ji   ,jj,jk,jp_sal)*twmsk(jj,jk) 
     486                  swbnd(jj,jk,nibm ,nit) = tsn(ji+1 ,jj,jk,jp_sal)*twmsk(jj,jk) 
    487487               END DO 
    488488            END DO 
    … …  
    750750                  snbnd(ji,jk,nibm ,nitm) = snbnd(ji,jk,nibm ,nit)*tnmsk(ji,jk) 
    751751         ! ... fields nit <== now (kt+1) 
    752                   tnbnd(ji,jk,nib  ,nit) = tn(ji,jj,  jk)*tnmsk(ji,jk) 
    753                   tnbnd(ji,jk,nibm ,nit) = tn(ji,jj-1,jk)*tnmsk(ji,jk) 
    754                   snbnd(ji,jk,nib  ,nit) = sn(ji,jj,  jk)*tnmsk(ji,jk) 
    755                   snbnd(ji,jk,nibm ,nit) = sn(ji,jj-1,jk)*tnmsk(ji,jk) 
     752                  tnbnd(ji,jk,nib  ,nit) = tsn(ji,jj,  jk,jp_tem)*tnmsk(ji,jk) 
     753                  tnbnd(ji,jk,nibm ,nit) = tsn(ji,jj-1,jk,jp_tem)*tnmsk(ji,jk) 
     754                  snbnd(ji,jk,nib  ,nit) = tsn(ji,jj,  jk,jp_sal)*tnmsk(ji,jk) 
     755                  snbnd(ji,jk,nibm ,nit) = tsn(ji,jj-1,jk,jp_sal)*tnmsk(ji,jk) 
    756756               END DO 
    757757            END DO 
    … …  
    10221022                  ssbnd(ji,jk,nibm ,nitm) = ssbnd(ji,jk,nibm ,nit)*tsmsk(ji,jk) 
    10231023         ! ... fields nit <== now (kt+1) 
    1024                   tsbnd(ji,jk,nib  ,nit) = tn(ji,jj   ,jk)*tsmsk(ji,jk) 
    1025                   tsbnd(ji,jk,nibm ,nit) = tn(ji,jj+1 ,jk)*tsmsk(ji,jk) 
    1026                   ssbnd(ji,jk,nib  ,nit) = sn(ji,jj   ,jk)*tsmsk(ji,jk) 
    1027                   ssbnd(ji,jk,nibm ,nit) = sn(ji,jj+1 ,jk)*tsmsk(ji,jk) 
     1024                  tsbnd(ji,jk,nib  ,nit) = tsn(ji,jj   ,jk,jp_tem)*tsmsk(ji,jk) 
     1025                  tsbnd(ji,jk,nibm ,nit) = tsn(ji,jj+1 ,jk,jp_tem)*tsmsk(ji,jk) 
     1026                  ssbnd(ji,jk,nib  ,nit) = tsn(ji,jj   ,jk,jp_sal)*tsmsk(ji,jk) 
     1027                  ssbnd(ji,jk,nibm ,nit) = tsn(ji,jj+1 ,jk,jp_sal)*tsmsk(ji,jk) 
    10281028               END DO 
    10291029            END DO 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/OBC/obctra.F90

    r2528 r2789  
    5858      !!                     
    5959      !! ** Purpose :   Compute tracer fields (t,s) along the open boundaries. 
    60       !!      This routine is called by the tranxt.F routine and updates ta,sa 
     60      !!      This routine is called by the tranxt.F routine and updates tsa 
    6161      !!      which are the actual temperature and salinity fields. 
    6262      !!        The logical variable lp_obc_east, and/or lp_obc_west, and/or lp_obc_north, 
    … …  
    101101      IF( lk_mpp ) THEN                  !!bug ??? 
    102102         IF( kt >= nit000+3 .AND. ln_rstart ) THEN 
    103             CALL lbc_lnk( tb, 'T', 1. ) 
    104             CALL lbc_lnk( sb, 'T', 1. ) 
     103            CALL lbc_lnk( tsb(:,:,:,jp_tem), 'T', 1. ) 
     104            CALL lbc_lnk( tsb(:,:,:,jp_sal), 'T', 1. ) 
    105105         END IF 
    106          CALL lbc_lnk( ta, 'T', 1. ) 
    107          CALL lbc_lnk( sa, 'T', 1. ) 
     106         CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. ) 
     107         CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 
    108108      ENDIF 
    109109 
    … …  
    116116      !!                   
    117117      !! ** Purpose : 
    118       !!      Apply the radiation algorithm on east OBC tracers ta, sa using the  
     118      !!      Apply the radiation algorithm on east OBC tracers tsa using the  
    119119      !!      phase velocities calculated in obc_rad_east subroutine in obcrad.F90 module 
    120120      !!      If the logical lfbceast is .TRUE., there is no radiation but only fixed OBC 
    … …  
    143143            DO jk = 1, jpkm1 
    144144               DO jj = 1, jpj 
    145                   ta(ji,jj,jk) = ta(ji,jj,jk) * (1. - temsk(jj,jk)) + & 
    146                                  tfoe(jj,jk)*temsk(jj,jk) 
    147                   sa(ji,jj,jk) = sa(ji,jj,jk) * (1. - temsk(jj,jk)) + & 
    148                                  sfoe(jj,jk)*temsk(jj,jk) 
     145                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1. - temsk(jj,jk)) + & 
     146                                         tfoe(jj,jk)*temsk(jj,jk) 
     147                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1. - temsk(jj,jk)) + & 
     148                                         sfoe(jj,jk)*temsk(jj,jk) 
    149149               END DO 
    150150            END DO 
    … …  
    191191                  ztau = (1.-zin ) * rtauein  + zin * rtaue 
    192192                  z05cx = z05cx * zin 
    193          ! ... update ( ta, sa ) with radiative or climatological (t, s) 
    194                   ta(ji,jj,jk) = ta(ji,jj,jk) * (1. - temsk(jj,jk)) +           &  
     193         ! ... update tsa with radiative or climatological ts 
     194                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1. - temsk(jj,jk)) +           & 
    195195                                 temsk(jj,jk) * ( ( 1. - z05cx - ztau )         & 
    196196                                 * tebnd(jj,jk,nib ,nitm) + 2.*z05cx              & 
    197197                                 * tebnd(jj,jk,nibm,nit ) + ztau * tfoe (jj,jk) ) & 
    198198                                 / (1. + z05cx) 
    199                   sa(ji,jj,jk) = sa(ji,jj,jk) * (1. - temsk(jj,jk)) +           &  
     199                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1. - temsk(jj,jk)) +           & 
    200200                                 temsk(jj,jk) * ( ( 1. - z05cx - ztau )         & 
    201201                                 * sebnd(jj,jk,nib ,nitm) + 2.*z05cx              & 
    … …  
    216216      !!            
    217217      !! ** Purpose : 
    218       !!      Apply the radiation algorithm on west OBC tracers ta, sa using the  
     218      !!      Apply the radiation algorithm on west OBC tracers tsa using the  
    219219      !!      phase velocities calculated in obc_rad_west subroutine in obcrad.F90 module 
    220220      !!      If the logical lfbcwest is .TRUE., there is no radiation but only fixed OBC 
    … …  
    244244            DO jk = 1, jpkm1 
    245245               DO jj = 1, jpj 
    246                   ta(ji,jj,jk) = ta(ji,jj,jk) * (1. - twmsk(jj,jk)) + & 
    247                                  tfow(jj,jk)*twmsk(jj,jk) 
    248                   sa(ji,jj,jk) = sa(ji,jj,jk) * (1. - twmsk(jj,jk)) + & 
    249                                  sfow(jj,jk)*twmsk(jj,jk) 
     246                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1. - twmsk(jj,jk)) + & 
     247                                         tfow(jj,jk)*twmsk(jj,jk) 
     248                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1. - twmsk(jj,jk)) + & 
     249                                         sfow(jj,jk)*twmsk(jj,jk) 
    250250               END DO 
    251251            END DO 
    … …  
    290290                  ztau = (1.-zin )*rtauwin + zin * rtauw 
    291291                  z05cx = z05cx * zin 
    292          ! ... update (ta,sa) with radiative or climatological (t, s) 
    293                   ta(ji,jj,jk) = ta(ji,jj,jk) * (1. - twmsk(jj,jk)) +           & 
     292         ! ... update tsa with radiative or climatological (ts) 
     293                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1. - twmsk(jj,jk)) +           & 
    294294                                 twmsk(jj,jk) * ( ( 1. + z05cx - ztau )         & 
    295295                                 * twbnd(jj,jk,nib ,nitm) - 2.*z05cx              & 
    296296                                 * twbnd(jj,jk,nibm,nit ) + ztau * tfow (jj,jk) ) & 
    297297                                 / (1. - z05cx) 
    298                   sa(ji,jj,jk) = sa(ji,jj,jk) * (1. - twmsk(jj,jk)) +           & 
     298                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1. - twmsk(jj,jk)) +           & 
    299299                                 twmsk(jj,jk) * ( ( 1. + z05cx - ztau )         & 
    300300                                 * swbnd(jj,jk,nib ,nitm) - 2.*z05cx              & 
    … …  
    343343            DO jk = 1, jpkm1 
    344344               DO ji = 1, jpi 
    345                   ta(ji,jj,jk)= ta(ji,jj,jk) * (1.-tnmsk(ji,jk)) + & 
    346                                 tnmsk(ji,jk) * tfon(ji,jk) 
    347                   sa(ji,jj,jk)= sa(ji,jj,jk) * (1.-tnmsk(ji,jk)) + & 
    348                                 tnmsk(ji,jk) * sfon(ji,jk) 
     345                  tsa(ji,jj,jk,jp_tem)= tsa(ji,jj,jk,jp_tem) * (1.-tnmsk(ji,jk)) + & 
     346                                        tnmsk(ji,jk) * tfon(ji,jk) 
     347                  tsa(ji,jj,jk,jp_sal)= tsa(ji,jj,jk,jp_sal) * (1.-tnmsk(ji,jk)) + & 
     348                                        tnmsk(ji,jk) * sfon(ji,jk) 
    349349               END DO 
    350350            END DO 
    … …  
    392392                  ztau = (1.-zin ) * rtaunin + zin * rtaun 
    393393                  z05cx = z05cx * zin 
    394          ! ... update (ta,sa) with radiative or climatological (t, s) 
    395                   ta(ji,jj,jk) = ta(ji,jj,jk) * (1.-tnmsk(ji,jk)) +             & 
     394         ! ... update tsa with radiative or climatological (t, s) 
     395                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1.-tnmsk(ji,jk)) +             & 
    396396                                 tnmsk(ji,jk) * ( ( 1. - z05cx - ztau )         & 
    397397                                 * tnbnd(ji,jk,nib ,nitm) + 2.*z05cx              & 
    398398                                 * tnbnd(ji,jk,nibm,nit ) + ztau * tfon (ji,jk) ) & 
    399399                                 / (1. + z05cx) 
    400                   sa(ji,jj,jk) = sa(ji,jj,jk) * (1.-tnmsk(ji,jk)) +             & 
     400                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1.-tnmsk(ji,jk)) +             & 
    401401                                 tnmsk(ji,jk) * ( ( 1. - z05cx - ztau )         & 
    402402                                 * snbnd(ji,jk,nib ,nitm) + 2.*z05cx              & 
    … …  
    417417      !!      
    418418      !! ** Purpose : 
    419       !!      Apply the radiation algorithm on south OBC tracers ta, sa using the  
     419      !!      Apply the radiation algorithm on south OBC tracers tsa using the  
    420420      !!      phase velocities calculated in obc_rad_south subroutine in obcrad.F90 module 
    421421      !!      If the logical lfbcsouth is .TRUE., there is no radiation but only fixed OBC 
    … …  
    445445            DO jk = 1, jpkm1 
    446446               DO ji = 1, jpi 
    447                   ta(ji,jj,jk)= ta(ji,jj,jk) * (1.-tsmsk(ji,jk)) + & 
    448                                 tsmsk(ji,jk) * tfos(ji,jk) 
    449                   sa(ji,jj,jk)= sa(ji,jj,jk) * (1.-tsmsk(ji,jk)) + & 
    450                                 tsmsk(ji,jk) * sfos(ji,jk) 
     447                  tsa(ji,jj,jk,jp_tem)= tsa(ji,jj,jk,jp_tem) * (1.-tsmsk(ji,jk)) + & 
     448                                        tsmsk(ji,jk) * tfos(ji,jk) 
     449                  tsa(ji,jj,jk,jp_sal)= tsa(ji,jj,jk,jp_sal) * (1.-tsmsk(ji,jk)) + & 
     450                                        tsmsk(ji,jk) * sfos(ji,jk) 
    451451               END DO 
    452452            END DO 
    … …  
    493493                  z05cx = z05cx * zin 
    494494 
    495          !... update (ta,sa) with radiative or climatological (t, s) 
    496                   ta(ji,jj,jk) = ta(ji,jj,jk) * (1.-tsmsk(ji,jk)) +             & 
     495         !... update tsa with radiative or climatological (t, s) 
     496                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) * (1.-tsmsk(ji,jk)) +             & 
    497497                                 tsmsk(ji,jk) * ( ( 1. + z05cx - ztau )         & 
    498498                                 * tsbnd(ji,jk,nib ,nitm) - 2.*z05cx              & 
    499499                                 * tsbnd(ji,jk,nibm,nit ) + ztau * tfos (ji,jk) ) & 
    500500                                 / (1. - z05cx) 
    501                   sa(ji,jj,jk) = sa(ji,jj,jk) * (1.-tsmsk(ji,jk)) +             & 
     501                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) * (1.-tsmsk(ji,jk)) +             & 
    502502                                 tsmsk(ji,jk) * (  ( 1. + z05cx - ztau )        & 
    503503                                 * ssbnd(ji,jk,nib ,nitm) - 2.*z05cx              & 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/OBS/diaobs.F90

    r2733 r2789  
    10111011         & rday                          
    10121012      USE oce, ONLY : &                 ! Ocean dynamics and tracers variables 
    1013          & tn,  &              
    1014          & sn,  & 
     1013         & tsn,  &              
    10151014         & un, vn,  & 
    10161015         & sshn 
    … …  
    10661065         DO jprofset = 1, nprofsets 
    10671066            IF ( ld_enact(jprofset) ) THEN 
    1068                CALL obs_pro_opt( prodatqc(jprofset),                          & 
    1069                   &              kstp, jpi, jpj, jpk, nit000, idaystp, tn, sn,& 
    1070                   &              gdept_0, tmask, n1dint, n2dint,              & 
     1067               CALL obs_pro_opt( prodatqc(jprofset),                     & 
     1068                  &              kstp, jpi, jpj, jpk, nit000, idaystp,   & 
     1069                  &              tsn(:,:,:,jp_tem), tsn(:,:,:,jp_sal),   & 
     1070                  &              gdept_0, tmask, n1dint, n2dint,         & 
    10711071                  &              kdailyavtypes = endailyavtypes ) 
    10721072            ELSE 
    1073                CALL obs_pro_opt( prodatqc(jprofset),                          & 
    1074                   &              kstp, jpi, jpj, jpk, nit000, idaystp, tn, sn,& 
     1073               CALL obs_pro_opt( prodatqc(jprofset),                     & 
     1074                  &              kstp, jpi, jpj, jpk, nit000, idaystp,   & 
     1075                  &              tsn(:,:,:,jp_tem), tsn(:,:,:,jp_sal),   & 
    10751076                  &              gdept_0, tmask, n1dint, n2dint               ) 
    10761077            ENDIF 
    … …  
    10911092         DO jsstset = 1, nsstsets 
    10921093            CALL obs_sst_opt( sstdatqc(jsstset),                 & 
    1093                &              kstp, jpi, jpj, nit000, tn(:,:,1), & 
     1094               &              kstp, jpi, jpj, nit000, tsn(:,:,1,jp_tem), & 
    10941095               &              tmask(:,:,1), n2dint ) 
    10951096         END DO 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcana.F90

    r2715 r2789  
    193193            ! 23.5 deg : tropics 
    194194            qsr (ji,jj) =  230 * COS( 3.1415 * ( gphit(ji,jj) - 23.5 * zcos_sais1 ) / ( 0.9 * 180 ) ) 
    195             qns (ji,jj) = ztrp * ( tb(ji,jj,1) - t_star ) - qsr(ji,jj) 
     195            qns (ji,jj) = ztrp * ( tsb(ji,jj,1,jp_tem) - t_star ) - qsr(ji,jj) 
    196196            IF( gphit(ji,jj) >= 14.845 .AND. 37.2 >= gphit(ji,jj) ) THEN    ! zero at 37.8 deg, max at 24.6 deg 
    197197               emp  (ji,jj) =   zemp_S * zconv   & 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r2715 r2789  
    4141   USE geo2ocean       !  
    4242   USE restart         ! 
    43    USE oce   , ONLY : tn, un, vn 
     43   USE oce   , ONLY : tsn, un, vn 
    4444   USE albedo          ! 
    4545   USE in_out_manager  ! I/O manager 
    … …  
    10861086      !!---------------------------------------------------------------------- 
    10871087      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    1088       USE wrk_nemo, ONLY:   zcptn  => wrk_2d_1   ! rcp * tn(:,:,1) 
     1088      USE wrk_nemo, ONLY:   zcptn  => wrk_2d_1   ! rcp * tsn(:,:,1,jp_tem) 
    10891089      USE wrk_nemo, ONLY:   ztmp   => wrk_2d_2   ! temporary array 
    10901090      USE wrk_nemo, ONLY:   zsnow  => wrk_2d_3   ! snow precipitation  
    … …  
    11151115 
    11161116      zicefr(:,:,1) = 1.- p_frld(:,:,1) 
    1117       IF( lk_diaar5 )   zcptn(:,:) = rcp * tn(:,:,1) 
     1117      IF( lk_diaar5 )   zcptn(:,:) = rcp * tsn(:,:,1,jp_tem) 
    11181118      ! 
    11191119      !                                                      ! ========================= ! 
    … …  
    12701270      !                                                      ! ------------------------- ! 
    12711271      SELECT CASE( cn_snd_temperature) 
    1272       CASE( 'oce only'             )   ;   ztmp1(:,:) =   tn(:,:,1) + rt0 
    1273       CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tn(:,:,1) + rt0 ) * zfr_l(:,:)    
     1272      CASE( 'oce only'             )   ;   ztmp1(:,:) =   tsn(:,:,1,jp_tem) + rt0 
     1273      CASE( 'weighted oce and ice' )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) 
    12741274                                           ztmp2(:,:) =   tn_ice(:,:,1)     *  fr_i(:,:) 
    1275       CASE( 'mixed oce-ice'        )   ;   ztmp1(:,:) = ( tn(:,:,1) + rt0 ) * zfr_l(:,:) + tn_ice(:,:,1) * fr_i(:,:) 
     1275      CASE( 'mixed oce-ice'        )   ;   ztmp1(:,:) = ( tsn(:,:,1,jp_tem) + rt0 ) * zfr_l(:,:) + tn_ice(:,:,1) * fr_i(:,:) 
    12761276      CASE default                     ;   CALL ctl_stop( 'sbc_cpl_snd: wrong definition of cn_snd_temperature' ) 
    12771277      END SELECT 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r2715 r2789  
    110110               ENDIF 
    111111 
    112                tn(ji,jj,1) = MAX( tn(ji,jj,1), zt_fzp )     ! avoid over-freezing point temperature 
     112               tsn(ji,jj,1,jp_tem) = MAX( tsn(ji,jj,1,jp_tem), zt_fzp )     ! avoid over-freezing point temperature 
    113113 
    114114               qsr(ji,jj) = ( 1. - zfr_obs ) * qsr(ji,jj)   ! solar heat flux : zero below observed ice cover 
    … …  
    117117               !      # ztrp*(t-(tgel-1.))  if observed ice and no opa ice   (zfr_obs=1 fr_i=0) 
    118118               !      # ztrp*min(0,t-tgel)  if observed ice and opa ice      (zfr_obs=1 fr_i=1) 
    119                zqri = ztrp * ( tb(ji,jj,1) - ( zt_fzp - 1.) ) 
    120                zqrj = ztrp * MIN( 0., tb(ji,jj,1) - zt_fzp ) 
     119               zqri = ztrp * ( tsb(ji,jj,1,jp_tem) - ( zt_fzp - 1.) ) 
     120               zqrj = ztrp * MIN( 0., tsb(ji,jj,1,jp_tem) - zt_fzp ) 
    121121               zqrp = ( zfr_obs * ( (1. - fr_i(ji,jj) ) * zqri    & 
    122122                 &                 +      fr_i(ji,jj)   * zqrj ) ) * tmask(ji,jj,1) 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r2715 r2789  
    327327      ! 
    328328      IF(ln_ctl) THEN         ! print mean trends (used for debugging) 
    329          CALL prt_ctl(tab2d_1=fr_i      , clinfo1=' fr_i     - : ', mask1=tmask, ovlap=1 ) 
    330          CALL prt_ctl(tab2d_1=(emp-rnf) , clinfo1=' emp-rnf  - : ', mask1=tmask, ovlap=1 ) 
    331          CALL prt_ctl(tab2d_1=(emps-rnf), clinfo1=' emps-rnf - : ', mask1=tmask, ovlap=1 ) 
    332          CALL prt_ctl(tab2d_1=qns       , clinfo1=' qns      - : ', mask1=tmask, ovlap=1 ) 
    333          CALL prt_ctl(tab2d_1=qsr       , clinfo1=' qsr      - : ', mask1=tmask, ovlap=1 ) 
    334          CALL prt_ctl(tab3d_1=tmask     , clinfo1=' tmask    - : ', mask1=tmask, ovlap=1, kdim=jpk ) 
    335          CALL prt_ctl(tab3d_1=tn        , clinfo1=' sst      - : ', mask1=tmask, ovlap=1, kdim=1   ) 
    336          CALL prt_ctl(tab3d_1=sn        , clinfo1=' sss      - : ', mask1=tmask, ovlap=1, kdim=1   ) 
    337          CALL prt_ctl(tab2d_1=utau      , clinfo1=' utau     - : ', mask1=umask,                      & 
    338             &         tab2d_2=vtau      , clinfo2=' vtau     - : ', mask2=vmask, ovlap=1 ) 
     329         CALL prt_ctl(tab2d_1=fr_i             , clinfo1=' fr_i     - : ', mask1=tmask, ovlap=1 ) 
     330         CALL prt_ctl(tab2d_1=(emp-rnf)        , clinfo1=' emp-rnf  - : ', mask1=tmask, ovlap=1 ) 
     331         CALL prt_ctl(tab2d_1=(emps-rnf)       , clinfo1=' emps-rnf - : ', mask1=tmask, ovlap=1 ) 
     332         CALL prt_ctl(tab2d_1=qns              , clinfo1=' qns      - : ', mask1=tmask, ovlap=1 ) 
     333         CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr      - : ', mask1=tmask, ovlap=1 ) 
     334         CALL prt_ctl(tab3d_1=tmask            , clinfo1=' tmask    - : ', mask1=tmask, ovlap=1, kdim=jpk ) 
     335         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' sst      - : ', mask1=tmask, ovlap=1, kdim=1   ) 
     336         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sss      - : ', mask1=tmask, ovlap=1, kdim=1   ) 
     337         CALL prt_ctl(tab2d_1=utau             , clinfo1=' utau     - : ', mask1=umask,                      & 
     338            &         tab2d_2=vtau             , clinfo2=' vtau     - : ', mask2=vmask, ovlap=1 ) 
    339339      ENDIF 
    340340      ! 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r2715 r2789  
    6464         ssu_m(:,:) = ub(:,:,1) 
    6565         ssv_m(:,:) = vb(:,:,1) 
    66          sst_m(:,:) = tn(:,:,1) 
    67          sss_m(:,:) = sn(:,:,1) 
     66         sst_m(:,:) = tsn(:,:,1,jp_tem) 
     67         sss_m(:,:) = tsn(:,:,1,jp_sal) 
    6868         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    6969         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    … …  
    104104               ssu_m(:,:) = zcoef * ub(:,:,1) 
    105105               ssv_m(:,:) = zcoef * vb(:,:,1) 
    106                sst_m(:,:) = zcoef * tn(:,:,1) 
    107                sss_m(:,:) = zcoef * sn(:,:,1) 
     106               sst_m(:,:) = zcoef * tsn(:,:,1,jp_tem) 
     107               sss_m(:,:) = zcoef * tsn(:,:,1,jp_sal) 
    108108               !                          ! removed inverse barometer ssh when Patm forcing is used  
    109109               IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
    … …  
    126126         ssu_m(:,:) = ssu_m(:,:) + ub(:,:,1) 
    127127         ssv_m(:,:) = ssv_m(:,:) + vb(:,:,1) 
    128          sst_m(:,:) = sst_m(:,:) + tn(:,:,1) 
    129          sss_m(:,:) = sss_m(:,:) + sn(:,:,1) 
     128         sst_m(:,:) = sst_m(:,:) + tsn(:,:,1,jp_tem) 
     129         sss_m(:,:) = sss_m(:,:) + tsn(:,:,1,jp_sal) 
    130130         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    131131         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 *  ( ssh_ib(:,:) + ssh_ibb(:,:) ) 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r2715 r2789  
    111111      !!---------------------------------------------------------------------- 
    112112      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    113       USE oce     , ONLY:   zwx => ua       , zwy  => va         ! (ua,va) used as 3D workspace 
    114       USE wrk_nemo, ONLY:   zwz => wrk_3d_1 , zind => wrk_3d_2   ! 3D workspace 
    115       USE wrk_nemo, ONLY:   ztfreez => wrk_2d_1                  ! 2D     - 
     113      USE oce     , ONLY:   zwx => ua        , zwy  => va          ! (ua,va) used as 3D workspace 
     114      USE wrk_nemo, ONLY:   zwz => wrk_3d_12 , zind => wrk_3d_13   ! 3D workspace 
     115      USE wrk_nemo, ONLY:   ztfreez => wrk_2d_1                    ! 2D     - 
    116116      ! 
    117117      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    … …  
    131131      !!---------------------------------------------------------------------- 
    132132 
    133       IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1,2) ) THEN 
     133      IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 12,13) ) THEN 
    134134         CALL ctl_stop('tra_adv_cen2: requested workspace arrays unavailable')   ;   RETURN 
    135135      ENDIF 
    … …  
    276276      ! 
    277277      IF( wrk_not_released(2, 1)   .OR.   & 
    278           wrk_not_released(3, 1,2) )   CALL ctl_stop('tra_adv_cen2: failed to release workspace arrays') 
     278          wrk_not_released(3, 12,13) )   CALL ctl_stop('tra_adv_cen2: failed to release workspace arrays') 
    279279      ! 
    280280   END SUBROUTINE tra_adv_cen2 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl.F90

    r2715 r2789  
    6363      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    6464      USE oce     , ONLY:   zwx   => ua       , zwy   => va          ! (ua,va) used as workspace 
    65       USE wrk_nemo, ONLY:   zslpx => wrk_3d_1 , zslpy => wrk_3d_2    ! 3D workspace 
     65      USE wrk_nemo, ONLY:   zslpx => wrk_3d_11 , zslpy => wrk_3d_12    ! 3D workspace 
    6666      ! 
    6767      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    … …  
    7979      !!---------------------------------------------------------------------- 
    8080 
    81       IF( wrk_in_use(3, 1,2) ) THEN 
     81      IF( wrk_in_use(3, 11,12) ) THEN 
    8282         CALL ctl_stop('tra_adv_muscl: requested workspace arrays unavailable')   ;   RETURN 
    8383      ENDIF 
    … …  
    252252      ENDDO 
    253253      ! 
    254       IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('tra_adv_muscl: requested workspace arrays unavailable') 
     254      IF( wrk_not_released(3, 11,12) )   CALL ctl_stop('tra_adv_muscl: requested workspace arrays unavailable') 
    255255      ! 
    256256   END SUBROUTINE tra_adv_muscl 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90

    r2715 r2789  
    6161      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    6262      USE oce     , ONLY:   zwx   => ua       , zwy   => va         ! (ua,va) used as 3D workspace 
    63       USE wrk_nemo, ONLY:   zslpx => wrk_3d_1 , zslpy => wrk_3d_2   ! 3D workspace 
     63      USE wrk_nemo, ONLY:   zslpx => wrk_3d_11, zslpy => wrk_3d_12   ! 3D workspace 
    6464      !! 
    6565      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    … …  
    7777      !!---------------------------------------------------------------------- 
    7878 
    79       IF( wrk_in_use(3, 1,2) ) THEN 
     79      IF( wrk_in_use(3, 11,12) ) THEN 
    8080         CALL ctl_stop('tra_adv_muscl2: requested workspace arrays are unavailable')   ;   RETURN 
    8181      ENDIF 
    … …  
    285285      END DO 
    286286      ! 
    287       IF( wrk_not_released(3, 1,2) )   CALL ctl_stop('tra_adv_muscl2: failed to release workspace arrays') 
     287      IF( wrk_not_released(3, 11,12) )   CALL ctl_stop('tra_adv_muscl2: failed to release workspace arrays') 
    288288      ! 
    289289   END SUBROUTINE tra_adv_muscl2 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_qck.F90

    r2715 r2789  
    117117      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    118118      USE oce     , ONLY:   zwx => ua       ! ua used as workspace 
    119       USE wrk_nemo, ONLY:   zfu => wrk_3d_1 , zfc => wrk_3d_2, zfd => wrk_3d_3   ! 3D workspace 
     119      USE wrk_nemo, ONLY:   zfu => wrk_3d_11 , zfc => wrk_3d_12, zfd => wrk_3d_13   ! 3D workspace 
    120120      ! 
    121121      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    … …  
    131131      !---------------------------------------------------------------------- 
    132132      ! 
    133       IF( wrk_in_use(3, 1,2,3) ) THEN 
     133      IF( wrk_in_use(3, 11,12,13) ) THEN 
    134134         CALL ctl_stop('tra_adv_qck_i: requested workspace arrays unavailable')   ;   RETURN 
    135135      ENDIF 
    … …  
    228228      END DO 
    229229      ! 
    230       IF( wrk_not_released(3, 1,2,3) )   CALL ctl_stop('tra_adv_qck_i: failed to release workspace arrays') 
     230      IF( wrk_not_released(3, 11,12,13) )   CALL ctl_stop('tra_adv_qck_i: failed to release workspace arrays') 
    231231      ! 
    232232   END SUBROUTINE tra_adv_qck_i 
    … …  
    240240      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    241241      USE oce     , ONLY:   zwy => ua       ! ua used as workspace 
    242       USE wrk_nemo, ONLY:   zfu => wrk_3d_1 , zfc => wrk_3d_2, zfd => wrk_3d_3   ! 3D workspace 
     242      USE wrk_nemo, ONLY:   zfu => wrk_3d_11 , zfc => wrk_3d_12, zfd => wrk_3d_13   ! 3D workspace 
    243243      ! 
    244244      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    … …  
    254254      !---------------------------------------------------------------------- 
    255255      ! 
    256       IF(wrk_in_use(3, 1,2,3))THEN 
     256      IF(wrk_in_use(3, 11,12,13))THEN 
    257257         CALL ctl_stop('tra_adv_qck_j: ERROR: requested workspace arrays unavailable') 
    258258         RETURN 
    … …  
    359359      END DO 
    360360      ! 
    361       IF( wrk_not_released(3, 1,2,3) )   CALL ctl_stop('tra_adv_qck_j: failed to release workspace arrays') 
     361      IF( wrk_not_released(3, 11,12,13) )   CALL ctl_stop('tra_adv_qck_j: failed to release workspace arrays') 
    362362      ! 
    363363   END SUBROUTINE tra_adv_qck_j 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/TRA/tradmp.F90

    r2715 r2789  
    1414   !!            3.2  ! 2009-08  (G. Madec, C. Talandier)  DOCTOR norm for namelist parameter 
    1515   !!            3.3  ! 2010-06  (C. Ethe, G. Madec) merge TRA-TRC  
     16   !!            3.4  ! 2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal + suppression of CPP keys 
    1617   !!---------------------------------------------------------------------- 
    17 #if   defined key_tradmp   ||   defined key_esopa 
    18    !!---------------------------------------------------------------------- 
    19    !!   'key_tradmp'                                       internal damping 
     18 
    2019   !!---------------------------------------------------------------------- 
    2120   !!   tra_dmp_alloc : allocate tradmp arrays 
    … …  
    3231   USE zdf_oce        ! ocean: vertical physics 
    3332   USE phycst         ! physical constants 
    34    USE dtatem         ! data: temperature 
    35    USE dtasal         ! data: salinity 
     33   USE dtatsd         ! data: temperature & salinity 
    3634   USE zdfmxl         ! vertical physics: mixed layer depth 
    3735   USE in_out_manager ! I/O manager 
    … …  
    4745   PUBLIC   dtacof_zoom  ! routine called by in both tradmp.F90 and trcdmp.F90 
    4846 
    49 #if ! defined key_agrif 
    50    LOGICAL, PUBLIC, PARAMETER ::   lk_tradmp = .TRUE.     !: internal damping flag 
    51 #else 
    52    LOGICAL, PUBLIC            ::   lk_tradmp = .TRUE.     !: internal damping flag 
    53 #endif 
     47   !                                !!* Namelist namtra_dmp : T & S newtonian damping * 
     48   LOGICAL, PUBLIC ::   ln_tradmp = .TRUE.    !: internal damping flag 
     49   INTEGER         ::   nn_hdmp   =   -1      ! = 0/-1/'latitude' for damping over T and S 
     50   INTEGER         ::   nn_zdmp   =    0      ! = 0/1/2 flag for damping in the mixed layer 
     51   REAL(wp)        ::   rn_surf   =   50._wp  ! surface time scale for internal damping        [days] 
     52   REAL(wp)        ::   rn_bot    =  360._wp  ! bottom time scale for internal damping         [days] 
     53   REAL(wp)        ::   rn_dep    =  800._wp  ! depth of transition between rn_surf and rn_bot [meters] 
     54   INTEGER         ::   nn_file   =    2      ! = 1 create a damping.coeff NetCDF file  
     55 
    5456   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   strdmp   !: damping salinity trend (psu/s) 
    5557   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ttrdmp   !: damping temperature trend (Celcius/s) 
    5658   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   resto    !: restoring coeff. on T and S (s-1) 
    57     
    58    !                                !!* Namelist namtra_dmp : T & S newtonian damping * 
    59    INTEGER  ::   nn_hdmp =   -1      ! = 0/-1/'latitude' for damping over T and S 
    60    INTEGER  ::   nn_zdmp =    0      ! = 0/1/2 flag for damping in the mixed layer 
    61    REAL(wp) ::   rn_surf =   50._wp  ! surface time scale for internal damping        [days] 
    62    REAL(wp) ::   rn_bot  =  360._wp  ! bottom time scale for internal damping         [days] 
    63    REAL(wp) ::   rn_dep  =  800._wp  ! depth of transition between rn_surf and rn_bot [meters] 
    64    INTEGER  ::   nn_file =    2      ! = 1 create a damping.coeff NetCDF file  
    6559 
    6660   !! * Substitutions 
    … …  
    7670   INTEGER FUNCTION tra_dmp_alloc() 
    7771      !!---------------------------------------------------------------------- 
    78       !!                ***  FUNCTION tra_bbl_alloc  *** 
    79       !!---------------------------------------------------------------------- 
    80       ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk) , resto(jpi,jpj,jpk), STAT= tra_dmp_alloc ) 
     72      !!                ***  FUNCTION tra_dmp_alloc  *** 
     73      !!---------------------------------------------------------------------- 
     74      ALLOCATE( strdmp(jpi,jpj,jpk) , ttrdmp(jpi,jpj,jpk), resto(jpi,jpj,jpk), STAT= tra_dmp_alloc ) 
    8175      ! 
    8276      IF( lk_mpp            )   CALL mpp_sum ( tra_dmp_alloc ) 
    8377      IF( tra_dmp_alloc > 0 )   CALL ctl_warn('tra_dmp_alloc: allocation of arrays failed') 
     78      ! 
    8479   END FUNCTION tra_dmp_alloc 
    8580 
    … …  
    10398      !! ** Action  : - (ta,sa)   tracer trends updated with the damping trend 
    10499      !!---------------------------------------------------------------------- 
     100      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
     101      USE wrk_nemo, ONLY:   zts_dta => wrk_4d_2  ! 4D workspace 
     102      ! 
    105103      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    106104      !! 
    107105      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    108       REAL(wp) ::   zta, zsa     ! local scalars 
    109       !!---------------------------------------------------------------------- 
     106      REAL(wp) ::   zta, zsa             ! local scalars 
     107      !!---------------------------------------------------------------------- 
     108      ! 
     109      IF( wrk_in_use(4, 2) ) THEN 
     110         CALL ctl_stop('tra_dmp: requested workspace arrays unavailable')   ;   RETURN 
     111      ENDIF 
     112      !                           !==   input T-S data at kt   ==! 
     113      CALL dta_tsd( kt, zts_dta )            ! read and interpolates T-S data at kt 
    110114      ! 
    111115      SELECT CASE ( nn_zdmp )     !==    type of damping   ==! 
    … …  
    115119            DO jj = 2, jpjm1 
    116120               DO ji = fs_2, fs_jpim1   ! vector opt. 
    117                   zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) ) 
    118                   zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) ) 
     121                  zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 
     122                  zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    119123                  tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) + zta 
    120124                  tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) + zsa 
    121                   strdmp(ji,jj,jk) = zsa           ! save the salinity trend (used in asmtrj) 
    122                   ttrdmp(ji,jj,jk) = zta 
     125                  strdmp(ji,jj,jk) = zsa           ! save the trend (used in asmtrj) 
     126                  ttrdmp(ji,jj,jk) = zta       
    123127               END DO 
    124128            END DO 
    … …  
    130134               DO ji = fs_2, fs_jpim1   ! vector opt. 
    131135                  IF( avt(ji,jj,jk) <= 5.e-4_wp ) THEN 
    132                      zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) ) 
    133                      zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) ) 
     136                     zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 
     137                     zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    134138                  ELSE 
    135139                     zta = 0._wp 
    … …  
    149153               DO ji = fs_2, fs_jpim1   ! vector opt. 
    150154                  IF( fsdept(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
    151                      zta = resto(ji,jj,jk) * ( t_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_tem) ) 
    152                      zsa = resto(ji,jj,jk) * ( s_dta(ji,jj,jk) - tsb(ji,jj,jk,jp_sal) ) 
     155                     zta = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 
     156                     zsa = resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    153157                  ELSE 
    154158                     zta = 0._wp 
    … …  
    173177         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    174178      ! 
     179      IF( wrk_not_released(4, 2) )  CALL ctl_stop('tra_dmp: failed to release workspace arrays') 
     180      ! 
    175181   END SUBROUTINE tra_dmp 
    176182 
    … …  
    184190      !! ** Method  :   read the nammbf namelist and check the parameters 
    185191      !!---------------------------------------------------------------------- 
    186       NAMELIST/namtra_dmp/ nn_hdmp, nn_zdmp, rn_surf, rn_bot, rn_dep, nn_file 
     192      NAMELIST/namtra_dmp/ ln_tradmp, nn_hdmp, nn_zdmp, rn_surf, rn_bot, rn_dep, nn_file 
    187193      !!---------------------------------------------------------------------- 
    188194 
    … …  
    194200      IF(lwp) THEN                       ! Namelist print 
    195201         WRITE(numout,*) 
    196          WRITE(numout,*) 'tra_dmp : T and S newtonian damping' 
     202         WRITE(numout,*) 'tra_dmp_init : T and S newtonian damping' 
    197203         WRITE(numout,*) '~~~~~~~' 
    198204         WRITE(numout,*) '   Namelist namtra_dmp : set damping parameter' 
    199          WRITE(numout,*) '      T and S damping option         nn_hdmp = ', nn_hdmp 
    200          WRITE(numout,*) '      mixed layer damping option     nn_zdmp = ', nn_zdmp, '(zoom: forced to 0)' 
    201          WRITE(numout,*) '      surface time scale (days)      rn_surf = ', rn_surf 
    202          WRITE(numout,*) '      bottom time scale (days)       rn_bot  = ', rn_bot 
    203          WRITE(numout,*) '      depth of transition (meters)   rn_dep  = ', rn_dep 
    204          WRITE(numout,*) '      create a damping.coeff file    nn_file = ', nn_file 
    205       ENDIF 
    206  
    207       !                              ! allocate tradmp arrays 
    208       IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' ) 
    209  
    210       SELECT CASE ( nn_hdmp ) 
    211       CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   tracer damping in the Med & Red seas only' 
    212       CASE ( 1:90 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping poleward of', nn_hdmp, ' degrees' 
    213       CASE DEFAULT 
    214          WRITE(ctmp1,*) '          bad flag value for nn_hdmp = ', nn_hdmp 
    215          CALL ctl_stop(ctmp1) 
    216       END SELECT 
    217  
    218       SELECT CASE ( nn_zdmp ) 
    219       CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column' 
    220       CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)' 
    221       CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer' 
    222       CASE DEFAULT 
    223          WRITE(ctmp1,*) 'bad flag value for nn_zdmp = ', nn_zdmp 
    224          CALL ctl_stop(ctmp1) 
    225       END SELECT 
    226  
    227       IF( .NOT.lk_dtasal .OR. .NOT.lk_dtatem )   & 
    228          &   CALL ctl_stop( 'no temperature and/or salinity data define key_dtatem and key_dtasal' ) 
    229  
    230       strdmp(:,:,:) = 0._wp       ! internal damping salinity trend (used in asmtrj) 
    231       ttrdmp(:,:,:) = 0._wp 
    232       !                          ! Damping coefficients initialization 
    233       IF( lzoom ) THEN   ;   CALL dtacof_zoom( resto ) 
    234       ELSE               ;   CALL dtacof( nn_hdmp, rn_surf, rn_bot, rn_dep,  & 
    235                              &            nn_file, 'TRA'  , resto            ) 
     205         WRITE(numout,*) '      add a damping termn or not      ln_tradmp = ', ln_tradmp 
     206         WRITE(numout,*) '      T and S damping option          nn_hdmp   = ', nn_hdmp 
     207         WRITE(numout,*) '      mixed layer damping option      nn_zdmp   = ', nn_zdmp, '(zoom: forced to 0)' 
     208         WRITE(numout,*) '      surface time scale (days)       rn_surf   = ', rn_surf 
     209         WRITE(numout,*) '      bottom time scale (days)        rn_bot    = ', rn_bot 
     210         WRITE(numout,*) '      depth of transition (meters)    rn_dep    = ', rn_dep 
     211         WRITE(numout,*) '      create a damping.coeff file     nn_file   = ', nn_file 
     212         WRITE(numout,*) 
     213      ENDIF 
     214 
     215      IF( ln_tradmp ) THEN               ! initialization for T-S damping 
     216         ! 
     217         IF( tra_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'tra_dmp_init: unable to allocate arrays' ) 
     218         ! 
     219         SELECT CASE ( nn_hdmp ) 
     220         CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   tracer damping in the Med & Red seas only' 
     221         CASE ( 1:90 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping poleward of', nn_hdmp, ' degrees' 
     222         CASE DEFAULT 
     223            WRITE(ctmp1,*) '          bad flag value for nn_hdmp = ', nn_hdmp 
     224            CALL ctl_stop(ctmp1) 
     225         END SELECT 
     226         ! 
     227         SELECT CASE ( nn_zdmp ) 
     228         CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column' 
     229         CASE ( 1 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the turbocline (avt > 5 cm2/s)' 
     230         CASE ( 2 )   ;   IF(lwp) WRITE(numout,*) '   no tracer damping in the mixed layer' 
     231         CASE DEFAULT 
     232            WRITE(ctmp1,*) 'bad flag value for nn_zdmp = ', nn_zdmp 
     233            CALL ctl_stop(ctmp1) 
     234         END SELECT 
     235         ! 
     236         IF( .NOT.ln_tsd_tradmp ) THEN 
     237            CALL ctl_warn( 'tra_dmp_init: read T-S data not initialized, we force ln_tsd_tradmp=T' ) 
     238            CALL dta_tsd_init( ld_tradmp=ln_tradmp )        ! forces the initialisation of T-S data 
     239         ENDIF 
     240         ! 
     241         strdmp(:,:,:) = 0._wp       ! internal damping salinity trend (used in asmtrj) 
     242         ttrdmp(:,:,:) = 0._wp 
     243         !                          ! Damping coefficients initialization 
     244         IF( lzoom ) THEN   ;   CALL dtacof_zoom( resto ) 
     245         ELSE               ;   CALL dtacof( nn_hdmp, rn_surf, rn_bot, rn_dep, nn_file, 'TRA', resto ) 
     246         ENDIF 
     247         ! 
    236248      ENDIF 
    237249      ! 
    … …  
    347359      !!---------------------------------------------------------------------- 
    348360 
    349       IF( wrk_in_use(1, 1) .OR.   & 
    350           wrk_in_use(2, 1) .OR.   & 
    351           wrk_in_use(3, 1)   ) THEN 
     361      IF( wrk_in_use(1, 1) .OR. wrk_in_use(2, 1) .OR. wrk_in_use(3, 1)  ) THEN  
    352362          CALL ctl_stop('dtacof: requested workspace arrays unavailable')   ;   RETURN 
    353363      ENDIF 
    … …  
    529539      ELSE                         !     No damping     ! 
    530540         !                         !--------------------! 
    531          CALL ctl_stop( 'Choose a correct value of nn_hdmp or DO NOT defined key_tradmp' ) 
     541         CALL ctl_stop( 'Choose a correct value of nn_hdmp or put ln_tradmp to FALSE' ) 
    532542      ENDIF 
    533543 
    … …  
    544554      ENDIF 
    545555      ! 
    546       IF( wrk_not_released(1, 1) .OR.   & 
    547           wrk_not_released(2, 1) .OR.   & 
    548           wrk_not_released(3, 1) )   CALL ctl_stop('dtacof: failed to release workspace arrays') 
     556      IF( wrk_not_released(1, 1) .OR.  wrk_not_released(2, 1) .OR. wrk_not_released(3, 1) )  &  
     557         &                      CALL ctl_stop('dtacof: failed to release workspace arrays') 
    549558      ! 
    550559   END SUBROUTINE dtacof 
    … …  
    572581      !!---------------------------------------------------------------------- 
    573582      USE ioipsl      ! IOipsl librairy 
    574       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    575       USE wrk_nemo, ONLY:   zxt => wrk_2d_1 , zyt => wrk_2d_2 , zzt => wrk_2d_3, zmask => wrk_2d_4 
     583      USE wrk_nemo, ONLY:  wrk_in_use, wrk_not_released 
     584      USE wrk_nemo, ONLY:  zxt => wrk_2d_1, zyt   => wrk_2d_2  
     585      USE wrk_nemo, ONLY:  zzt => wrk_2d_3, zmask => wrk_2d_4 
    576586      !! 
    577587      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out ) ::   pdct   ! distance to the coastline 
    … …  
    585595      !!---------------------------------------------------------------------- 
    586596 
    587       IF( wrk_in_use(2, 1,2,3,4) .OR.  & 
    588           wrk_in_use(1, 1,2,3,4)  ) THEN 
     597      IF( wrk_in_use(2, 1,2,3,4) ) THEN 
    589598          CALL ctl_stop('cofdis: requested workspace arrays unavailable')   ;   RETURN 
    590599      ENDIF 
    … …  
    745754      CALL restclo( icot ) 
    746755      ! 
    747       IF( wrk_not_released(2, 1,2,3,4) .OR. &  
    748           wrk_not_released(1, 1,2,3,4)  )   CALL ctl_stop('cofdis: failed to release workspace arrays') 
    749       DEALLOCATE( llcotu , llcotv , llcotf ,      & 
    750          &        zxc    , zyc    , zzc    , zdis ) 
     756      IF( wrk_not_released(2, 1,2,3,4) ) CALL ctl_stop('cofdis: failed to release workspace arrays') 
     757      DEALLOCATE( llcotu, llcotv, llcotf, zyc, zzc, zdis ) 
    751758      ! 
    752759   END SUBROUTINE cofdis 
    753  
    754 #else 
    755    !!---------------------------------------------------------------------- 
    756    !!   Default key                                     NO internal damping 
    757    !!---------------------------------------------------------------------- 
    758    LOGICAL , PUBLIC, PARAMETER ::   lk_tradmp = .FALSE.    !: internal damping flag 
    759 CONTAINS 
    760    SUBROUTINE tra_dmp( kt )        ! Empty routine 
    761       WRITE(*,*) 'tra_dmp: You should not have seen this print! error?', kt 
    762    END SUBROUTINE tra_dmp 
    763    SUBROUTINE tra_dmp_init        ! Empty routine 
    764    END SUBROUTINE tra_dmp_init 
    765 #endif 
    766  
    767760   !!====================================================================== 
    768761END MODULE tradmp 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/TRA/tranxt.F90

    r2715 r2789  
    4242   USE prtctl          ! Print control 
    4343   USE traqsr          ! penetrative solar radiation (needed for nksr) 
    44    USE traswp          ! swap array 
    4544   USE obc_oce  
    4645#if defined key_agrif 
    … …  
    111110      CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 
    112111      ! 
    113 #if defined key_obc || defined key_bdy || defined key_agrif 
    114       CALL tra_unswap 
    115 #endif 
    116  
    117112#if defined key_obc  
    118113      IF( lk_obc )   CALL obc_tra( kt )  ! OBC open boundaries 
    … …  
    123118#if defined key_agrif 
    124119      CALL Agrif_tra                     ! AGRIF zoom boundaries 
    125 #endif 
    126  
    127 #if defined key_obc || defined key_bdy || defined key_agrif 
    128       CALL tra_swap 
    129120#endif 
    130121  
    … …  
    155146#if defined key_agrif 
    156147      ! Update tracer at AGRIF zoom boundaries 
    157       CALL tra_unswap 
    158148      IF( .NOT.Agrif_Root() )    CALL Agrif_Update_Tra( kt )      ! children only 
    159       CALL tra_swap 
    160149#endif       
    161150      ! 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/TRD/trdicp.F90

    r2781 r2789  
    106106         ! 
    107107      CASE( 'TRA' )              ! Tracers 
    108          t2(ktrd) = SUM( ptrd2dx(:,:) * e1e2t(:,:) * fse3t(:,:,1) * tn(:,:,1) ) 
    109          s2(ktrd) = SUM( ptrd2dy(:,:) * e1e2t(:,:) * fse3t(:,:,1) * sn(:,:,1) ) 
     108         t2(ktrd) = SUM( ptrd2dx(:,:) * e1e2t(:,:) * fse3t(:,:,1) * tsn(:,:,1,jp_tem) ) 
     109         s2(ktrd) = SUM( ptrd2dy(:,:) * e1e2t(:,:) * fse3t(:,:,1) * tsn(:,:,1,jp_sal) ) 
    110110         !       
    111111      END SELECT 
    … …  
    184184         s2(ktrd) = 0._wp 
    185185         DO jk = 1, jpkm1 
    186             t2(ktrd) = t2(ktrd) + SUM( ptrd3dx(:,:,jk) * tn(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
    187             s2(ktrd) = s2(ktrd) + SUM( ptrd3dy(:,:,jk) * sn(:,:,jk) * e1e2t(:,:) * fse3t(:,:,jk) ) 
     186            t2(ktrd) = t2(ktrd) + SUM( ptrd3dx(:,:,jk) * tsn(:,:,jk,jp_tem) * e1e2t(:,:) * fse3t(:,:,jk) ) 
     187            s2(ktrd) = s2(ktrd) + SUM( ptrd3dy(:,:,jk) * tsn(:,:,jk,jp_sal) * e1e2t(:,:) * fse3t(:,:,jk) ) 
    188188         END DO 
    189189         ! 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/TRD/trdmld.F90

    r2715 r2789  
    293293               zavt = avt(ji,jj,ik) 
    294294               tmltrd(ji,jj,jpmld_zdf) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik)  & 
    295                   &                      * ( tn(ji,jj,ik-1) - tn(ji,jj,ik) )         & 
     295                  &                      * ( tsn(ji,jj,ik-1,jp_tem) - tsn(ji,jj,ik,jp_tem) )         & 
    296296                  &                      / MAX( 1., rmld(ji,jj) ) * tmask(ji,jj,1) 
    297297               zavt = fsavs(ji,jj,ik) 
    298298               smltrd(ji,jj,jpmld_zdf) = - zavt / fse3w(ji,jj,ik) * tmask(ji,jj,ik)  & 
    299                   &                      * ( sn(ji,jj,ik-1) - sn(ji,jj,ik) )         & 
     299                  &                      * ( tsn(ji,jj,ik-1,jp_sal) - tsn(ji,jj,ik,jp_sal) )         & 
    300300                  &                      / MAX( 1., rmld(ji,jj) ) * tmask(ji,jj,1) 
    301301            END DO 
    … …  
    334334      tml(:,:) = 0.e0   ;   sml(:,:) = 0.e0 
    335335      DO jk = 1, jpktrd - 1 
    336          tml(:,:) = tml(:,:) + wkx(:,:,jk) * tn(:,:,jk) 
    337          sml(:,:) = sml(:,:) + wkx(:,:,jk) * sn(:,:,jk)  
     336         tml(:,:) = tml(:,:) + wkx(:,:,jk) * tsn(:,:,jk,jp_tem) 
     337         sml(:,:) = sml(:,:) + wkx(:,:,jk) * tsn(:,:,jk,jp_sal) 
    338338      END DO 
    339339 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/TRD/trdmod.F90

    r2715 r2789  
    101101            CASE ( jptra_trd_zad )   ;   CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype )   ! z- vertical adv  
    102102                                         CALL trd_icp( ptrdx, ptrdy, jpicpt_zad, ctype )    
    103                                          ! compute the surface flux condition wn(:,:,1)*tn(:,:,1) 
    104                                          z2dx(:,:) = wn(:,:,1)*tn(:,:,1)/fse3t(:,:,1) 
    105                                          z2dy(:,:) = wn(:,:,1)*sn(:,:,1)/fse3t(:,:,1) 
     103                                         ! compute the surface flux condition wn(:,:,1)*tsn(:,:,1,jp_tem) 
     104                                         z2dx(:,:) = wn(:,:,1)*tsn(:,:,1,jp_tem)/fse3t(:,:,1) 
     105                                         z2dy(:,:) = wn(:,:,1)*tsn(:,:,1,jp_sal)/fse3t(:,:,1) 
    106106                                         CALL trd_icp( z2dx , z2dy , jpicpt_zl1, ctype )   ! 1st z- vertical adv  
    107107            END SELECT 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r2715 r2789  
    131131      !!              coefficients using the GLS turbulent closure scheme. 
    132132      !!---------------------------------------------------------------------- 
    133       USE oce,     z_elem_a  =>   ua   ! use ua as workspace 
    134       USE oce,     z_elem_b  =>   va   ! use va as workspace 
    135       USE oce,     z_elem_c  =>   ta   ! use ta as workspace 
    136       USE oce,     psi       =>   sa   ! use sa as workspace 
     133      USE oce     , ONLY z_elem_a  =>   ua   ! use ua as workspace 
     134      USE oce     , ONLY z_elem_b  =>   va   ! use va as workspace 
     135      USE oce     , ONLY tsa                 ! use tsa as workspace 
    137136      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    138137      USE wrk_nemo, ONLY: zdep  => wrk_2d_1 
    … …  
    152151      REAL(wp) ::   prod, buoy, diss, zdiss, sm         !   -      - 
    153152      REAL(wp) ::   gh, gm, shr, dif, zsqen, zav        !   -      - 
     153      REAL(wp), POINTER, DIMENSION(:,:,:) :: z_elem_c, psi 
    154154      !!-------------------------------------------------------------------- 
    155155 
    … …  
    157157         CALL ctl_stop('zdf_gls: requested workspace arrays unavailable.')   ;   RETURN 
    158158      END IF 
     159      ! 
     160      z_elem_c  => tsa(:,:,:,1) 
     161      psi       => tsa(:,:,:,2) 
    159162 
    160163      ! Preliminary computing 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90

    r2715 r2789  
    206206      !!         the equation number. (LMD94, here after) 
    207207      !!---------------------------------------------------------------------- 
    208 #if defined  key_zdfddm 
    209208      USE oce     , zviscos => ua   ! temp. array for viscosities use ua as workspace 
    210       USE oce     , zdiffut => ta   ! temp. array for diffusivities use sa as workspace 
    211       USE oce     , zdiffus => sa   ! temp. array for diffusivities use sa as workspace 
    212 #else 
    213       USE oce     , zviscos => ua   ! temp. array for viscosities use ua as workspace 
    214       USE oce     , zdiffut => ta   ! temp. array for diffusivities use sa as workspace 
    215 #endif 
     209      USE oce     , zdiffut => va   ! temp. array for diffusivities use sa as workspace 
    216210      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, wrk_in_use_xz, wrk_not_released_xz 
    217211      USE wrk_nemo, ONLY: zBo    => wrk_2d_1, &  ! Surface buoyancy forcing, 
    … …  
    229223                          zblct => wrk_xz_2      !  diffusivities/viscosities 
    230224#if defined key_zdfddm 
    231       USE wrk_nemo, ONLY: zblcs => wrk_xz_3 
     225      USE wrk_nemo, ONLY: zdiffus => wrk_3d_1 
     226      USE wrk_nemo, ONLY: zblcs   => wrk_xz_3 
    232227#endif 
    233228      !! 
    … …  
    270265      REAL(wp), POINTER, DIMENSION(:,:) ::     zdifs 
    271266      REAL(wp), POINTER, DIMENSION(:)   ::   za2s, za3s, zkmps 
    272       REAL(wp) ::                       zkm1s 
     267      REAL(wp) ::                            zkm1s 
    273268#endif 
    274269      !!-------------------------------------------------------------------- 
    … …  
    276271      IF( wrk_in_use(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) .OR.   & 
    277272          wrk_in_use(2, 1,2,3,4,5,6,7,8,9,10,11)          .OR.   & 
     273          wrk_in_use(3, 1)                                .OR. & 
    278274          wrk_in_use_xz(1,2,3)                              ) THEN 
    279275         CALL ctl_stop('zdf_kpp : requested workspace arrays unavailable.')   ;   RETURN 
    … …  
    369365               ! only retains positive value of rrau 
    370366               zrrau = MAX( rrau(ji,jj,jk), epsln ) 
    371                zds   = sn(ji,jj,jk-1) - sn(ji,jj,jk) 
     367               zds   = tsn(ji,jj,jk-1,jp_sal) - tsn(ji,jj,jk,jp_sal) 
    372368               IF( zrrau > 1. .AND. zds > 0.) THEN 
    373369                  ! 
    … …  
    418414         DO ji = fs_2, fs_jpim1      
    419415            IF( nn_eos < 1) THEN    
    420                zt     = tn(ji,jj,1) 
    421                zs     = sn(ji,jj,1) - 35.0 
     416               zt     = tsn(ji,jj,1,jp_tem) 
     417               zs     = tsn(ji,jj,1,jp_sal) - 35.0 
    422418               zh     = fsdept(ji,jj,1) 
    423419               !  potential volumic mass 
    … …  
    449445 
    450446               zthermal = zbeta * zalbet / ( rcp * zrhos + epsln ) 
    451                zhalin   = zbeta * sn(ji,jj,1) * rcs 
     447               zhalin   = zbeta * tsn(ji,jj,1,jp_sal) * rcs 
    452448            ELSE 
    453449               zrhos    = rhop(ji,jj,1) + rau0 * ( 1. - tmask(ji,jj,1) ) 
    454450               zthermal = rn_alpha / ( rcp * zrhos + epsln ) 
    455                zhalin   = rn_beta * sn(ji,jj,1) * rcs 
     451               zhalin   = rn_beta * tsn(ji,jj,1,jp_sal) * rcs 
    456452            ENDIF 
    457453            ! Radiative surface buoyancy force 
    … …  
    462458            wt0(ji,jj) = - ( qsr(ji,jj) + qns(ji,jj) )* ro0cpr * tmask(ji,jj,1) 
    463459            ! Surface salinity flux for non-local term 
    464             ws0(ji,jj) = - ( ( emps(ji,jj)-rnf(ji,jj) ) * sn(ji,jj,1) * rcs ) * tmask(ji,jj,1)  
     460            ws0(ji,jj) = - ( ( emps(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal) * rcs ) * tmask(ji,jj,1)  
    465461         ENDDO 
    466462      ENDDO 
    … …  
    543539               ! zref = gdept(1) 
    544540               zref = fsdept(ji,jj,1) 
    545                zt   = tn(ji,jj,1) 
    546                zs   = sn(ji,jj,1) 
     541               zt   = tsn(ji,jj,1,jp_tem) 
     542               zs   = tsn(ji,jj,1,jp_sal) 
    547543               zrh  = rhop(ji,jj,1) 
    548544               zu   = ( ub(ji,jj,1) + ub(ji - 1,jj    ,1) ) / MAX( 1. , umask(ji,jj,1) + umask(ji - 1,jj   ,1) ) 
    … …  
    556552               ! vertically integration over the upper epsilon*gdept(jk) ; del () array is computed once in zdf_kpp_init 
    557553               DO jm = 1, jpkm1 
    558                   zt   = zt  + del(jk,jm) * tn(ji,jj,jm) 
    559                   zs   = zs  + del(jk,jm) * sn(ji,jj,jm) 
     554                  zt   = zt  + del(jk,jm) * tsn(ji,jj,jm,jp_tem) 
     555                  zs   = zs  + del(jk,jm) * tsn(ji,jj,jm,jp_sal) 
    560556                  zu   = zu  + 0.5 * del(jk,jm) & 
    561557                     &            * ( ub(ji,jj,jm) + ub(ji - 1,jj,jm) ) & 
    … …  
    567563               END DO 
    568564#endif 
    569                zsr = SQRT( ABS( sn(ji,jj,jk) ) ) 
     565               zsr = SQRT( ABS( tsn(ji,jj,jk,jp_sal) ) ) 
    570566               ! depth 
    571567               zh = fsdept(ji,jj,jk) 
    … …  
    12341230         ENDIF 
    12351231 
    1236       IF( wrk_not_released(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) .OR.   & 
    1237           wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11)          .OR.   & 
    1238           wrk_not_released_xz(1,2,3)                               )  & 
    1239           CALL ctl_stop('zdf_kpp : failed to release workspace arrays') 
     1232      IF( wrk_not_released(1, 1,2,3,4,5,6,7,8,9,10,11,12,13,14) .OR. & 
     1233          wrk_not_released(2, 1,2,3,4,5,6,7,8,9,10,11)          .OR. & 
     1234          wrk_not_released(3, 1)                                .OR. & 
     1235          wrk_not_released_xz(1,2,3)  )   CALL ctl_stop('zdf_kpp : failed to release workspace arrays') 
    12401236      ! 
    12411237   END SUBROUTINE zdf_kpp 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r2715 r2789  
    191191      !! --------------------------------------------------------------------- 
    192192      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released, iwrk_in_use, iwrk_not_released 
    193       USE oce     , ONLY:   zdiag => ua , zd_up => va , zd_lw => ta   ! (ua,va,ta) used as workspace 
     193      USE oce     , ONLY:   zdiag => ua          ! (ua,va) used  as workspace 
     194      USE oce     , ONLY:   tsa                  ! (tsa) used  as workspace 
    194195      USE wrk_nemo, ONLY:   imlc  => iwrk_2d_1   ! 2D INTEGER workspace 
    195196      USE wrk_nemo, ONLY:   zhlc  =>  wrk_2d_1   ! 2D REAL workspace 
    196197      USE wrk_nemo, ONLY:   zpelc =>  wrk_3d_1   ! 3D REAL workspace 
    197       ! 
     198      !! 
    198199      INTEGER  ::   ji, jj, jk                      ! dummy loop arguments 
    199200!!bfr      INTEGER  ::   ikbu, ikbv, ikbum1, ikbvm1      ! temporary scalar 
    … …  
    208209      REAL(wp) ::   zzd_up, zzd_lw                  !    -         - 
    209210!!bfr      REAL(wp) ::   zebot                           !    -         - 
     211      REAL(wp), POINTER, DIMENSION(:,:,:) :: zd_up, zd_lw 
    210212      !!-------------------------------------------------------------------- 
    211213      ! 
    … …  
    215217         CALL ctl_stop('tke_tke: requested workspace arrays unavailable')   ;   RETURN 
    216218      END IF 
     219      ! 
     220      zd_up => tsa(:,:,:,1)  
     221      zd_lw => tsa(:,:,:,2)  
    217222 
    218223      zbbrau = rn_ebb / rau0       ! Local constant initialisation 
    … …  
    471476      !!              - avmu, avmv : now vertical eddy viscosity at uw- and vw-points 
    472477      !!---------------------------------------------------------------------- 
    473       USE oce, ONLY:   zmpdl => ua , zmxlm => va , zmxld => ta   ! (ua,va,ta) used as workspace 
     478      USE oce, ONLY:  zmpdl => ua    ! ua used as workspace 
     479      USE oce, ONLY:  tsa            ! use tsa as workspace 
    474480      !! 
    475481      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    477483      REAL(wp) ::   zdku, zpdlr, zri, zsqen     !   -      - 
    478484      REAL(wp) ::   zdkv, zemxl, zemlm, zemlp   !   -      - 
     485      REAL(wp), POINTER, DIMENSION(:,:,:) :: zmxlm, zmxld 
    479486      !!-------------------------------------------------------------------- 
     487      ! 
     488      zmxlm => tsa(:,:,:,1)  
     489      zmxld => tsa(:,:,:,2)  
    480490 
    481491      !                     !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r2715 r2789  
    320320                            CALL tra_bbc_init   ! bottom heat flux 
    321321      IF( lk_trabbl     )   CALL tra_bbl_init   ! advective (and/or diffusive) bottom boundary layer scheme 
    322       IF( lk_tradmp     )   CALL tra_dmp_init   ! internal damping trends 
     322      IF( ln_tradmp     )   CALL tra_dmp_init   ! internal damping trends 
    323323                            CALL tra_adv_init   ! horizontal & vertical advection 
    324324                            CALL tra_ldf_init   ! lateral mixing 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/oce.F90

    r2715 r2789  
    2525   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rotb ,  rotn           !: relative vorticity           [s-1] 
    2626   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   hdivb,  hdivn          !: horizontal divergence        [s-1] 
    27    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   tb   ,  tn    , ta     !: potential temperature    [Celcius] 
    28    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   sb   ,  sn    , sa     !: salinity                     [psu] 
    29    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa    !: 4D T-S fields        [Celcius,psu]  
     27   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn            !: 4D T-S fields        [Celcius,psu]  
    3028   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2   [s-2] 
     29   ! 
     30   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:), TARGET ::  tsa             !: 4D T-S trends fields & work array  
    3131   ! 
    3232   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0  [no units] 
    … …  
    6666         &      rotb (jpi,jpj,jpk)      , rotn (jpi,jpj,jpk)      ,                             &    
    6767         &      hdivb(jpi,jpj,jpk)      , hdivn(jpi,jpj,jpk)      ,                             & 
    68          &      tb   (jpi,jpj,jpk)      , tn   (jpi,jpj,jpk)      , ta(jpi,jpj,jpk)       ,     & 
    69          &      sb   (jpi,jpj,jpk)      , sn   (jpi,jpj,jpk)      , sa (jpi,jpj,jpk)      ,     &       
    7068         &      tsb  (jpi,jpj,jpk,jpts) , tsn  (jpi,jpj,jpk,jpts) , tsa(jpi,jpj,jpk,jpts) ,     & 
    7169         &      rn2b (jpi,jpj,jpk)      , rn2  (jpi,jpj,jpk)                              , STAT=ierr(1) ) 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/step.F90

    r2715 r2789  
    2323   !!            3.3  !  2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface 
    2424   !!             -   !  2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 
     25   !!            3.4  !  2011-04  (G. Madec, C. Ethe) Merge of dtatem and dtasal 
    2526   !!---------------------------------------------------------------------- 
    2627 
    … …  
    9495      ! Update data, open boundaries, surface boundary condition (including sea-ice) 
    9596      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    96       IF( lk_dtatem  )   CALL dta_tem( kstp )         ! update 3D temperature data 
    97       IF( lk_dtasal  )   CALL dta_sal( kstp )         ! update 3D salinity data 
    9897                         CALL sbc    ( kstp )         ! Sea Boundary Condition (including sea-ice) 
    9998      IF( lk_obc     )   CALL obc_dta( kstp )         ! update dynamic and tracer data at open boundaries 
    … …  
    107106 
    108107      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    109       ! Ocean physics update                (ua, va, ta, sa used as workspace) 
     108      ! Ocean physics update                (ua, va, tsa used as workspace) 
    110109      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    111110                         CALL bn2( tsb, rn2b )        ! before Brunt-Vaisala frequency 
    … …  
    158157 
    159158      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    160       ! diagnostics and outputs             (ua, va, ta, sa used as workspace) 
     159      ! diagnostics and outputs             (ua, va, tsa used as workspace) 
    161160      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    162161      IF( lk_floats  )   CALL flo_stp( kstp )         ! drifting Floats 
    … …  
    185184      IF( ln_trabbc      )   CALL tra_bbc    ( kstp )       ! bottom heat flux 
    186185      IF( lk_trabbl      )   CALL tra_bbl    ( kstp )       ! advective (and/or diffusive) bottom boundary layer scheme 
    187       IF( lk_tradmp      )   CALL tra_dmp    ( kstp )       ! internal damping trends 
     186      IF( ln_tradmp      )   CALL tra_dmp    ( kstp )       ! internal damping trends 
    188187                             CALL tra_adv    ( kstp )       ! horizontal & vertical advection 
    189188      IF( lk_zdfkpp      )   CALL tra_kpp    ( kstp )       ! KPP non-local tracer fluxes 
    190189                             CALL tra_ldf    ( kstp )       ! lateral mixing 
    191190#if defined key_agrif 
    192                              CALL tra_unswap 
    193191      IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_tra          ! tracers sponge 
    194                              CALL tra_swap 
    195192#endif 
    196193                             CALL tra_zdf    ( kstp )       ! vertical mixing and after tracer fields 
    … …  
    210207                             CALL tra_nxt( kstp )                ! tracer fields at next time step 
    211208      ENDIF  
    212                              CALL tra_unswap                ! udate T & S 3D arrays  (to be suppressed) 
    213  
    214       !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    215       ! Dynamics                                    (ta, sa used as workspace) 
     209 
     210      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
     211      ! Dynamics                                    (tsa used as workspace) 
    216212      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    217213                               ua(:,:,:) = 0.e0             ! set dynamics trends to zero 
    … …  
    250246 
    251247      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    252       ! Trends                              (ua, va, ta, sa used as workspace) 
     248      ! Trends                              (ua, va, tsa used as workspace) 
    253249      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    254250      IF( nstop == 0 ) THEN                          

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r2528 r2789  
    1717   USE daymod           ! calendar                         (day     routine) 
    1818 
    19    USE dtatem           ! ocean temperature data           (dta_tem routine) 
    20    USE dtasal           ! ocean salinity    data           (dta_sal routine) 
    2119   USE sbcmod           ! surface boundary condition       (sbc     routine) 
    2220   USE sbcrnf           ! surface boundary condition: runoff variables 
    … …  
    9290   USE prtctl           ! Print control                    (prt_ctl routine) 
    9391 
    94    USE traswp           ! Swap arrays           (tra_swp, tra_unswp routine) 
    95  
    9692   USE diaobs           ! Observation operator 
    9793 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/stpctl.F90

    r2528 r2789  
    108108      !                                              !* Test minimum of salinity 
    109109      !                                              !  ------------------------ 
    110       !! zsmin = MINVAL( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5 
     110      !! zsmin = MINVAL( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 )  slower than the following loop on NEC SX5 
    111111      zsmin = 100.e0 
    112112      DO jj = 2, jpjm1 
    113113         DO ji = 1, jpi 
    114             IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,sn(ji,jj,1)) 
     114            IF( tmask(ji,jj,1) == 1) zsmin = MIN(zsmin,tsn(ji,jj,1,jp_sal)) 
    115115         END DO 
    116116      END DO 
    … …  
    121121      IF( zsmin < 0.) THEN  
    122122         IF (lk_mpp) THEN 
    123             CALL mpp_minloc ( sn(:,:,1),tmask(:,:,1), zsmin, ii,ij ) 
     123            CALL mpp_minloc ( tsn(:,:,1,jp_sal),tmask(:,:,1), zsmin, ii,ij ) 
    124124         ELSE 
    125             ilocs = MINLOC( sn(:,:,1), mask = tmask(:,:,1) == 1.e0 ) 
     125            ilocs = MINLOC( tsn(:,:,1,jp_sal), mask = tmask(:,:,1) == 1.e0 ) 
    126126            ii = ilocs(1) + nimpp - 1 
    127127            ij = ilocs(2) + njmpp - 1 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/OPA_SRC/wrk_nemo.F90

    r2749 r2789  
    7373   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  , TARGET, PUBLIC ::   wrk_3d_6 , wrk_3d_7 , wrk_3d_8 , wrk_3d_9 , wrk_3d_10 
    7474   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  , TARGET, PUBLIC ::   wrk_3d_11, wrk_3d_12, wrk_3d_13, wrk_3d_14, wrk_3d_15 
     75   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  , TARGET, PUBLIC ::   wrk_3d_16, wrk_3d_17, wrk_3d_18, wrk_3d_19 
    7576 
    7677   !                                                               !!**  4D, x-y-z-tra, REAL(wp) workspaces  ** 
    … …  
    169170      ALLOCATE( wrk_3d_1 (jpi,jpj,jpk) , wrk_3d_2 (jpi,jpj,jpk) , wrk_3d_3 (jpi,jpj,jpk) , wrk_3d_4 (jpi,jpj,jpk) ,     & 
    170171         &      wrk_3d_5 (jpi,jpj,jpk) , wrk_3d_6 (jpi,jpj,jpk) , wrk_3d_7 (jpi,jpj,jpk) , wrk_3d_8 (jpi,jpj,jpk) ,     & 
    171          &      wrk_3d_9 (jpi,jpj,jpk) , wrk_3d_10(jpi,jpj,jpk)                                                   ,     &  
    172          &      wrk_3d_11(jpi,jpj,jpk) , wrk_3d_12(jpi,jpj,jpk) , wrk_3d_13(jpi,jpj,jpk) , wrk_3d_14(jpi,jpj,jpk) ,     &  
    173          &      wrk_3d_15(jpi,jpj,jpk)                                                                            , STAT=ierror(3) ) 
     172         &      wrk_3d_9 (jpi,jpj,jpk) , wrk_3d_10(jpi,jpj,jpk) , wrk_3d_11(jpi,jpj,jpk) , wrk_3d_12(jpi,jpj,jpk) ,     &  
     173         &      wrk_3d_13(jpi,jpj,jpk) , wrk_3d_14(jpi,jpj,jpk) , wrk_3d_15(jpi,jpj,jpk) , wrk_3d_16(jpi,jpj,jpk) ,     &  
     174         &      wrk_3d_17(jpi,jpj,jpk) , wrk_3d_18(jpi,jpj,jpk) , wrk_3d_19(jpi,jpj,jpk)                          , STAT=ierror(3) ) 
    174175         ! 
    175176      ALLOCATE( wrk_4d_1(jpi,jpj,jpk,jpts) , wrk_4d_2(jpi,jpj,jpk,jpts),     & 

  • branches/2011/dev_r2787_LOCEAN3_TRA_TRP/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r2787 r2789  
    184184   USE oce , ONLY :   vn      =>    vn      !: j-horizontal velocity (m s-1) 
    185185   USE oce , ONLY :   wn      =>    wn      !: vertical velocity (m s-1)   
    186    USE oce , ONLY :   tn      =>    tn      !: pot. temperature (celsius) 
    187    USE oce , ONLY :   sn      =>    sn      !: salinity (psu) 
    188186   USE oce , ONLY :   tsn     =>    tsn     !: 4D array contaning ( tn, sn ) 
    189187   USE oce , ONLY :   tsb     =>    tsb     !: 4D array contaning ( tb, sb ) 
Note: See TracChangeset for help on using the changeset viewer.