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 2077 – NEMO

Changeset 2077


Ignore:
Timestamp:
2010-09-09T10:43:51+02:00 (14 years ago)
Author:
cbricaud
Message:

commit change from DEV_r1784_3DF

Location:
branches/devmercator2010
Files:
27 edited

Legend:

Unmodified
Added
Removed
  • branches/devmercator2010/CONFIG/ORCA2_LIM/EXP00/AA_job

    r2075 r2077  
    117117 
    118118#- Files for the configuration and ocean dynamics 
    119 Rapatrie ${R_TMP} ORCA2_LIM_nemo_v3.1.tar 
     119Rapatrie ${R_TMP} ORCA2_LIM_nemo_v3.2.tar 
    120120 
    121121ls -alF 
  • branches/devmercator2010/CONFIG/ORCA2_LIM/EXP00/namelist

    r2075 r2077  
    275275   rn_alphdi   =    0.72   !  (Pyane, 1972) 
    276276/ 
    277  
     277!----------------------------------------------------------------------- 
     278&namdta_tem    !   surface boundary condition : sea surface restoring 
     279!----------------------------------------------------------------------- 
     280!              !     file name                  ! frequency (hours) ! variable   ! time interpol. !  clim   !'yearly' or ! weights  ! rotation ! 
     281!              !                                !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly'  ! filename ! pairing  ! 
     282  sn_tem       = 'data_1m_potential_temperature_nomask',  -1        , 'votemper' ,     .true.     , .true.  , 'yearly'   , ' '      , ' ' 
     283! 
     284  cn_dir       = './'      !  root directory for the location of the runoff files 
     285/ 
     286!----------------------------------------------------------------------- 
     287&namdta_sal    !   surface boundary condition : sea surface restoring 
     288!----------------------------------------------------------------------- 
     289!              !     file name                  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly' or ! weights  ! rotation ! 
     290!              !                                !  (if <0  months)  !   name     !    (logical)   !  (T/F)  !  'monthly'  ! filename ! pairing  ! 
     291   sn_sal      =  'data_1m_salinity_nomask'     ,         -1        , 'vosaline' ,     .true.     , .true.  , 'yearly'    , ''       , ' ' 
     292 
     293   cn_dir      = './'      !  root directory for the location of the runoff files 
     294/ 
    278295!!====================================================================== 
    279296!!               ***  Lateral boundary condition  *** 
     
    417434   ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries   
    418435   ln_traadv_ubs    =  .false.  !  UBS scheme                  
     436   !ln_traadv_ppm    =  .true.  !  UBS scheme                  
    419437/ 
    420438!----------------------------------------------------------------------- 
     
    698716&namptr       !   Poleward Transport Diagnostic 
    699717!----------------------------------------------------------------------- 
    700    ln_diaptr  = .true.     !  Poleward heat and salt transport (T) or not (F) 
     718   ln_diaptr  = .false.     !  Poleward heat and salt transport (T) or not (F) 
    701719   ln_diaznl  = .true.     !  Add zonal means and meridional stream functions 
    702720   ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not  
  • branches/devmercator2010/CONFIG/ORCA2_LIM_PISCES/EXP00/AA_job

    r2075 r2077  
    117117 
    118118#- Files for the configuration and ocean dynamics 
    119 Rapatrie ${R_TMP} ORCA2_LIM_nemo_v3.1.tar 
     119Rapatrie ${R_TMP} ORCA2_LIM_nemo_v3.2.tar 
    120120Rapatrie ${R_TMP} INPUTS_INIT_v3.tar 
    121121Rapatrie ${R_TMP} INPUTS_PISCES_v3.tar 
  • branches/devmercator2010/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist

    r2075 r2077  
    275275   rn_alphdi   =    0.72   !  (Pyane, 1972) 
    276276/ 
    277  
     277!----------------------------------------------------------------------- 
     278&namdta_tem    !   surface boundary condition : sea surface restoring 
     279!----------------------------------------------------------------------- 
     280!              !     file name                  ! frequency (hours) ! variable   ! time interpol. !  clim   !'yearly' or ! weights  ! rotation ! 
     281!              !                                !  (if <0  months)  !   name     !    (logical)   !  (T/F)  ! 'monthly'  ! filename ! pairing  ! 
     282  sn_tem       = 'data_1m_potential_temperature_nomask',  -1        , 'votemper' ,     .true.     , .true.  , 'yearly'   , ' '      , ' ' 
     283! 
     284  cn_dir       = './'      !  root directory for the location of the runoff files 
     285/ 
     286!----------------------------------------------------------------------- 
     287&namdta_sal    !   surface boundary condition : sea surface restoring 
     288!----------------------------------------------------------------------- 
     289!              !     file name                  ! frequency (hours) ! variable   ! time interpol. !  clim   ! 'yearly' or ! weights  ! rotation ! 
     290!              !                                !  (if <0  months)  !   name     !    (logical)   !  (T/F)  !  'monthly'  ! filename ! pairing  ! 
     291   sn_sal      =  'data_1m_salinity_nomask'     ,         -1        , 'vosaline' ,     .true.     , .true.  , 'yearly'    , ''       , ' ' 
     292! 
     293   cn_dir      = './'      !  root directory for the location of the runoff files 
     294/ 
    278295!!====================================================================== 
    279296!!               ***  Lateral boundary condition  *** 
  • branches/devmercator2010/NEMO/LIM_SRC_2/dom_ice_2.F90

    r2076 r2077  
    55   !!====================================================================== 
    66   !! History :   2.0  !  03-08  (C. Ethe)  Free form and module 
    7    !!             3.3  !  09-05 (G.Garric) addition of the lim2_evp cas 
    87   !!---------------------------------------------------------------------- 
    98#if defined key_lim2 
     
    2726      &                                              area   ,         &  !: surface of grid cell  
    2827      &                                              tms    , tmu        !: temperature and velocity points masks 
    29    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2)     ::   wght                !: weight of the 4 neighbours to compute averages 
     28   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2)     ::   wght   ,         &  !: weight of the 4 neighbours to compute averages 
     29      &                                              akappa , bkappa     !: first and third group of metric coefficients 
     30   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2,2,2) ::   alambd   !: second group of metric coefficients 
    3031 
    31 #if defined key_lim2_vp 
    32    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2)     ::                     & 
    33       &                                              akappa , bkappa     !: first and third group of metric coefficients 
    34    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,2,2,2,2) ::   alambd              !: second group of metric coefficients 
    35 #else 
    36    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   tmv    , tmf        !: y-velocity and F-points masks 
    37    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         ::   tmi                 !: ice mask: =1 if ice thick > 0 
    38 #endif 
    3932   !!====================================================================== 
    4033#endif 
  • branches/devmercator2010/NEMO/LIM_SRC_2/ice_2.F90

    r2076 r2077  
    55   !!===================================================================== 
    66   !! History :  2.0  !  03-08  (C. Ethe)  F90: Free form and module 
    7    !!            3.3  !  09-05 (G.Garric) addition of the lim2_evp cas 
    87   !!---------------------------------------------------------------------- 
    98#if defined key_lim2 
     
    2625   LOGICAL               , PUBLIC ::   ln_limdyn     = .TRUE.             !: flag for ice dynamics (T) or not (F) 
    2726   LOGICAL               , PUBLIC ::   ln_limdmp     = .FALSE.            !: Ice damping 
    28    LOGICAL               , PUBLIC ::   ln_nicep      = .TRUE.             !: flag for sea-ice points output (T) or not (F) 
    2927   REAL(wp)              , PUBLIC ::   hsndif        = 0.e0               !: computation of temp. in snow (0) or not (9999) 
    3028   REAL(wp)              , PUBLIC ::   hicdif        = 0.e0               !: computation of temp. in ice (0) or not (9999) 
     
    4846   REAL(wp), PUBLIC ::   ecc    = 2.e0      !: eccentricity of the elliptical yield curve 
    4947   REAL(wp), PUBLIC ::   ahi0   = 350.e0    !: sea-ice hor. eddy diffusivity coeff. (m2/s) 
    50    INTEGER , PUBLIC ::   nevp   =   360     !: number of EVP subcycling iterations 
    51    INTEGER , PUBLIC ::   telast =  3600     !: timescale for EVP elastic waves 
    52    REAL(wp), PUBLIC ::   alphaevp = 1.e0    !: coefficient for the solution of EVP int. stresses 
     48 
    5349   REAL(wp), PUBLIC ::   usecc2             !:  = 1.0 / ( ecc * ecc ) 
    5450   REAL(wp), PUBLIC ::   rhoco              !: = rau0 * cw 
     
    5652   REAL(wp), PUBLIC ::   pstarh             !: pstar / 2.0 
    5753 
    58    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ahiu , ahiv         !: hor. diffusivity coeff. at ocean U- and V-points (m2/s) 
    59    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   pahu , pahv         !: ice hor. eddy diffusivity coef. at ocean U- and V-points 
    60    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ust2s               !: friction velocity 
    61  
    62 #if  defined key_lim2_vp 
    63    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hsnm , hicm         !: mean snow and ice thicknesses 
    64    CHARACTER(len=1), PUBLIC :: cl_grid =   'B'                   !: type of grid used in ice dynamics, 'C' or 'B' 
    65 #else 
    66    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::                      & 
    67                                                    stress1_i ,  &!: first stress tensor element        
    68                                                    stress2_i ,  &!: second stress tensor element 
    69                                                    stress12_i,  &!: diagonal stress tensor element 
    70                                                    delta_i   ,  &!: Delta factor for the ice rheology (see Flato and Hibler 95) [s-1] -> limrhg.F90 
    71                                                    divu_i    ,  &!: Divergence of the velocity field [s-1] -> limrhg.F90 
    72                                                    shear_i       !: Shear of the velocity field [s-1] -> limrhg.F90 
    73  
    74    REAL(wp), PUBLIC, DIMENSION(jpi,jpj)         :: at_i          !: 
    75    REAL(wp), PUBLIC, DIMENSION(:,:)    ,POINTER :: vt_s ,vt_i    !: mean snow and ice thicknesses 
    76    REAL(wp), PUBLIC, DIMENSION(jpi,jpj),TARGET  :: hsnm , hicm   !: mean snow and ice thicknesses, target for pointers vt_s and vt_i  
    77    CHARACTER(len=1), PUBLIC :: cl_grid =   'C'                   !: type of grid used in ice dynamics, 'C' or 'B' 
    78 #endif 
     54   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ahiu , ahiv   !: hor. diffusivity coeff. at ocean U- and V-points (m2/s) 
     55   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   pahu , pahv   !: ice hor. eddy diffusivity coef. at ocean U- and V-points 
     56   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   hsnm , hicm   !: mean snow and ice thicknesses 
     57   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   ust2s                 !: friction velocity 
    7958 
    8059   !!* diagnostic quantities 
    81    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdvosif       !: Variation of volume at surface (only used for outputs) 
    82    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdvobif       !: Variation of ice volume at the bottom ice (only used for outputs) 
    83    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   fdvolif       !: Total variation of ice volume (only used for outputs) 
    84    REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   rdvonif       !: Lateral Variation of ice volume (only used for outputs) 
    8560   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   sist          !: Sea-Ice Surface Temperature (Kelvin) 
    8661   REAL(wp), PUBLIC, DIMENSION(jpi,jpj) ::   tfu           !: Freezing/Melting point temperature of sea water at SSS 
  • branches/devmercator2010/NEMO/LIM_SRC_2/iceini_2.F90

    r2076 r2077  
    66   !! History :   1.0  !  02-08  (G. Madec)  F90: Free form and modules 
    77   !!             2.0  !  03-08  (C. Ethe)  add ice_run 
    8    !!             3.3  !  09-05  (G.Garric) addition of the lim2_evp case 
    98   !!---------------------------------------------------------------------- 
    109#if defined key_lim2 
     
    3130 
    3231   PUBLIC   ice_init_2               ! called by sbcice_lim_2.F90 
    33  
    34    INTEGER , PUBLIC  ::     numit                  !: iteration number 
    35  
    3632 
    3733   !!---------------------------------------------------------------------- 
     
    6662      ENDIF 
    6763       
    68       tn_ice(:,:,1) = sist(:,:)       ! initialisation of ice temperature    
     64      tn_ice(:,:,1) = sist(:,:)         ! initialisation of ice temperature    
    6965      fr_i  (:,:) = 1.0 - frld(:,:)   ! initialisation of sea-ice fraction     
    70       ! 
    71       numit = nit000 - 1              !initialisation ice time-step 
    72  
    7366      ! 
    7467   END SUBROUTINE ice_init_2 
  • branches/devmercator2010/NEMO/LIM_SRC_2/limdyn_2.F90

    r2076 r2077  
    88   !!             2.0  !  03-08  (C. Ethe) add lim_dyn_init 
    99   !!             2.0  !  06-07  (G. Madec)  Surface module 
    10    !!             3.3  !  09-05  (G.Garric) addition of the lim2_evp cas 
    1110   !!--------------------------------------------------------------------- 
    1211#if defined key_lim2 
     
    2322   USE dom_ice_2      ! 
    2423   USE limistate_2    ! 
    25 #if defined key_lim2_vp 
    2624   USE limrhg_2       ! ice rheology 
    27 #else 
    28    USE limrhg         ! ice rheology 
    29 #endif 
     25 
    3026   USE lbclnk         ! 
    3127   USE lib_mpp        ! 
     
    9187            i_jpj = jpj 
    9288            IF(ln_ctl)   CALL prt_ctl_info( 'lim_dyn  :    i_j1 = ', ivar1=i_j1, clinfo2=' ij_jpj = ', ivar2=i_jpj ) 
    93 #if defined key_lim2_vp 
    9489            CALL lim_rhg_2( i_j1, i_jpj ) 
    95 #else 
    96             CALL lim_rhg( i_j1, i_jpj ) !!!!cbr CALL lim_rhg( i_j1, i_jpj, kt ) 
    97 #endif 
    9890            ! 
    9991         ELSE                                 ! optimization of the computational area 
     
    113105                  i_j1 = i_j1 + 1 
    114106               END DO 
    115 #if defined key_lim2_vp 
    116107               i_j1 = MAX( 1, i_j1-1 ) 
    117108               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : NH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 
    118109               !  
    119110               CALL lim_rhg_2( i_j1, i_jpj ) 
    120 #else 
    121                i_j1 = MAX( 1, i_j1-2 ) 
    122                IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : NH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 
    123                CALL lim_rhg( i_j1, i_jpj ) 
    124 #endif 
    125111               !  
    126112               ! Southern hemisphere 
     
    130116                  i_jpj = i_jpj - 1 
    131117               END DO 
    132 #if defined key_lim2_vp 
    133118               i_jpj = MIN( jpj, i_jpj+2 ) 
    134119               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : SH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 
    135120               !  
    136121               CALL lim_rhg_2( i_j1, i_jpj ) 
    137 #else 
    138                i_jpj = MIN( jpj, i_jpj+1 ) 
    139                IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : SH i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 
    140                CALL lim_rhg( i_j1, i_jpj ) !!!!cbr CALL lim_rhg( i_j1, i_jpj, kt ) 
    141 #endif 
    142122               !  
    143123            ELSE                                 ! local domain extends over one hemisphere only 
     
    154134                  i_jpj = i_jpj - 1 
    155135               END DO 
    156 #if defined key_lim2_vp 
    157136               i_jpj = MIN( jpj, i_jpj+2) 
    158  
     137     
    159138               IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : one hemisphere: i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 
    160139               !  
    161140               CALL lim_rhg_2( i_j1, i_jpj ) 
    162 #else 
    163                i_j1 = MAX( 1, i_j1-2 ) 
    164                i_jpj = MIN( jpj, i_jpj+1) 
    165                IF(ln_ctl)   WRITE(numout,*) 'lim_dyn : one hemisphere: i_j1 = ', i_j1, ' ij_jpj = ', i_jpj 
    166                CALL lim_rhg( i_j1, i_jpj ) !!!!cbr CALL lim_rhg( i_j1, i_jpj, kt ) 
    167 #endif 
    168141               ! 
    169142            ENDIF 
     
    175148         ! computation of friction velocity 
    176149         ! -------------------------------- 
    177  
    178      SELECT CASE( cl_grid ) 
    179  
    180       CASE( 'C' )                          ! C-grid ice dynamics 
    181          !????????????????????????????????? 
    182          ! ice-ocean velocity at U & V-points (u_ice vi_ice at U- & V-points ; ssu_m, ssv_m at U- & V-points) 
    183          zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 
    184          zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 
    185  
    186  
    187       CASE( 'B' )                          ! B-grid ice dynamics 
    188150         ! ice-ocean velocity at U & V-points (u_ice v_ice at I-point ; ssu_m, ssv_m at U- & V-points) 
    189151          
     
    194156            END DO 
    195157         END DO 
    196  
    197       END SELECT 
    198  
    199158         ! frictional velocity at T-point 
    200159         DO jj = 2, jpjm1 
     
    239198      NAMELIST/namicedyn/ epsd, alpha,     & 
    240199         &                dm, nbiter, nbitdr, om, resl, cw, angvg, pstar,   & 
    241          &                c_rhg, etamn, creepl, ecc, ahi0, & 
    242          &                nevp, telast, alphaevp 
     200         &                c_rhg, etamn, creepl, ecc, ahi0 
    243201      !!------------------------------------------------------------------- 
    244202 
     
    265223         WRITE(numout,*) '       eccentricity of the elliptical yield curve       ecc    = ', ecc 
    266224         WRITE(numout,*) '       horizontal diffusivity coeff. for sea-ice        ahi0   = ', ahi0 
    267          WRITE(numout,*) '       number of iterations for subcycling              nevp   = ', nevp 
    268          WRITE(numout,*) '       timescale for elastic waves                      telast = ', telast 
    269          WRITE(numout,*) '       coefficient for the solution of int. stresses  alphaevp = ', alphaevp 
    270225      ENDIF 
    271226 
  • branches/devmercator2010/NEMO/LIM_SRC_2/limmsh_2.F90

    r2076 r2077  
    4747      !!         original    : 01-04 (LIM) 
    4848      !!         addition    : 02-08 (C. Ethe, G. Madec) 
    49       !!         additions   : 2009-05 (addition of the lim2_evp case, G. Garric) 
    5049      !!---------------------------------------------------------------------  
    5150      !! * Local variables 
    5251      INTEGER :: ji, jj      ! dummy loop indices 
    5352 
    54       REAL(wp) ::         & 
    55          zusden              ! temporary scalars 
    56 #if defined key_lim2_vp 
    5753      REAL(wp), DIMENSION(jpi,jpj) ::  & 
    5854         zd2d1 , zd1d2       ! Derivative of zh2 (resp. zh1) in the x direction 
     
    6157         zh1p  , zh2p   , &  ! Idem zh1, zh2 for the bottom left corner of the grid 
    6258         zd2d1p, zd1d2p , &  ! Idem zd2d1, zd1d2 for the bottom left corner of the grid 
    63          zusden2             ! temporary scalars 
    64 #endif 
     59         zusden, zusden2     ! temporary scalars 
    6560      !!--------------------------------------------------------------------- 
    6661 
     
    117112      !------------------- 
    118113!!ibug ??? 
     114      akappa(:,:,:,:) = 0.e0 
    119115      wght(:,:,:,:) = 0.e0 
    120       tmu(:,:)      = 0.e0 
    121 #if defined key_lim2_vp  
    122       akappa(:,:,:,:)     = 0.e0 
    123116      alambd(:,:,:,:,:,:) = 0.e0 
    124 #else 
    125       tmv(:,:) = 0.e0 
    126       tmf(:,:) = 0.e0 
    127 #endif 
     117      tmu(:,:) = 0.e0 
    128118!!i 
    129119       
    130 #if defined key_lim2_vp 
     120       
    131121      ! metric coefficients for sea ice dynamic 
    132122      !---------------------------------------- 
     
    162152      CALL lbc_lnk( wght(:,:,2,1), 'I', 1. )      ! but it is never used 
    163153      CALL lbc_lnk( wght(:,:,2,2), 'I', 1. ) 
    164 #else 
    165       !                                                      ! weights (wght) 
    166       DO jj = 2, jpj-1 
    167          DO ji = 2, jpi-1 
    168             zusden = 1. / (  ( e1t(ji+1,jj) + e1t(ji,jj  ) )   & 
    169                &           * ( e2t(ji,jj+1) + e2t(ji  ,jj) ) )  
    170             wght(ji,jj,1,1) = zusden * e1t(ji+1,jj) * e2t(ji,jj+1) 
    171             wght(ji,jj,1,2) = zusden * e1t(ji+1,jj) * e2t(ji,jj  ) 
    172             wght(ji,jj,2,1) = zusden * e1t(ji  ,jj) * e2t(ji,jj+1) 
    173             wght(ji,jj,2,2) = zusden * e1t(ji  ,jj) * e2t(ji,jj  ) 
    174          END DO 
    175       END DO 
    176  
    177       !With EVP, the weights are calculated on 'F' points 
    178       CALL lbc_lnk( wght(:,:,1,1), 'F', 1. )      ! CAUTION: even with the lbc_lnk at ice U-V-point 
    179       CALL lbc_lnk( wght(:,:,1,2), 'F', 1. )      ! the value of wght at jpj is wrong 
    180       CALL lbc_lnk( wght(:,:,2,1), 'F', 1. )      ! but it is never used 
    181       CALL lbc_lnk( wght(:,:,2,2), 'F', 1. ) 
    182  
    183 #endif 
    184154     
    185155      ! Coefficients for divergence of the stress tensor 
    186156      !------------------------------------------------- 
    187157 
    188 #if defined key_lim2_vp 
    189158      DO jj = 2, jpj 
    190159         DO ji = 2, jpi   ! NO vector opt. 
     
    254223      CALL lbc_lnk( alambd(:,:,2,1,1,1), 'I', 1. )      ! 
    255224      CALL lbc_lnk( alambd(:,:,2,1,1,2), 'I', 1. )      ! 
    256 #endif 
    257225             
    258226 
     
    265233      tmu(:,1) = 0.e0 
    266234      tmu(1,:) = 0.e0 
    267  
    268 #if defined key_lim2_vp 
    269235      DO jj = 2, jpj               ! ice U.V-point: computed from ice T-point mask 
    270236         DO ji = 2, jpim1   ! NO vector opt. 
     
    275241      !--lateral boundary conditions     
    276242      CALL lbc_lnk( tmu(:,:), 'I', 1. ) 
    277 #else 
    278       tmv(:,1) = 0.e0 !SB 
    279       tmv(1,:) = 0.e0 !SB 
    280       tmf(1,:) = 0.e0 
    281       tmf(:,1) = 0.e0 
    282       DO jj = 1, jpj - 1 
    283          DO ji = 1 , jpi - 1 
    284             tmu(ji,jj) =  tms(ji,jj) * tms(ji+1,jj) 
    285             tmv(ji,jj) =  tms(ji,jj) * tms(ji,jj+1) 
    286             tmf(ji,jj) =  tms(ji,jj) * tms(ji+1,jj) * tms(ji,jj+1) * & 
    287                tms(ji+1,jj+1) 
    288          END DO 
    289       END DO 
    290  
    291       !--lateral boundary conditions 
    292       CALL lbc_lnk( tmu(:,:), 'U', 1. ) 
    293       CALL lbc_lnk( tmv(:,:), 'V', 1. ) 
    294       CALL lbc_lnk( tmf(:,:), 'F', 1. ) 
    295 #endif 
    296243       
    297244      ! unmasked and masked area of T-grid cell 
  • branches/devmercator2010/NEMO/LIM_SRC_2/limrhg_2.F90

    r2076 r2077  
    99   !!            " "  !  06-08  (G. Madec)  surface module, ice-stress at I-point 
    1010   !!            " "  !  09-09  (G. Madec)  Huge verctor optimisation 
    11    !!            3.3  !  09-05  (G.Garric) addition of the lim2_evp case 
    12    !!---------------------------------------------------------------------- 
    13 #if defined key_lim2 &&  defined key_lim2_vp 
     11   !!---------------------------------------------------------------------- 
     12#if defined key_lim2 
    1413   !!---------------------------------------------------------------------- 
    1514   !!   'key_lim2'                                    LIM 2.0 sea-ice model 
  • branches/devmercator2010/NEMO/LIM_SRC_2/limrst_2.F90

    r2076 r2077  
    66   !! History :  2.0  !  01-04  (C. Ethe, G. Madec)  Original code 
    77   !!                 !  06-07  (S. Masson)  use IOM for restart read/write 
    8    !!            3.3  !  09-05  (G.Garric) addition of the lim2_evp case 
    98   !!---------------------------------------------------------------------- 
    109#if defined key_lim2 
     
    109108      CALL iom_rstput( iter, nitrst, numriw, 'kt_ice', REAL( iter, wp) )  
    110109       
    111       CALL iom_rstput( iter, nitrst, numriw, 'hicif'      , hicif     (:,:)   )      ! prognostic variables  
    112       CALL iom_rstput( iter, nitrst, numriw, 'hsnif'      , hsnif     (:,:)   ) 
    113       CALL iom_rstput( iter, nitrst, numriw, 'frld'       , frld      (:,:)   ) 
    114       CALL iom_rstput( iter, nitrst, numriw, 'sist'       , sist      (:,:)   ) 
    115       CALL iom_rstput( iter, nitrst, numriw, 'tbif1'      , tbif      (:,:,1) ) 
    116       CALL iom_rstput( iter, nitrst, numriw, 'tbif2'      , tbif      (:,:,2) ) 
    117       CALL iom_rstput( iter, nitrst, numriw, 'tbif3'      , tbif      (:,:,3) ) 
    118       CALL iom_rstput( iter, nitrst, numriw, 'u_ice'      , u_ice     (:,:)   ) 
    119       CALL iom_rstput( iter, nitrst, numriw, 'v_ice'      , v_ice     (:,:)   ) 
    120       CALL iom_rstput( iter, nitrst, numriw, 'qstoif'     , qstoif    (:,:)   ) 
    121       CALL iom_rstput( iter, nitrst, numriw, 'fsbbq'      , fsbbq     (:,:)   ) 
    122 #if ! defined key_lim2_vp 
    123       CALL iom_rstput( iter, nitrst, numriw, 'stress1_i'  , stress1_i (:,:)   ) 
    124       CALL iom_rstput( iter, nitrst, numriw, 'stress2_i'  , stress2_i (:,:)   ) 
    125       CALL iom_rstput( iter, nitrst, numriw, 'stress12_i' , stress12_i(:,:)   ) 
    126 #endif 
    127       CALL iom_rstput( iter, nitrst, numriw, 'sxice' ,      sxice     (:,:)   ) 
    128       CALL iom_rstput( iter, nitrst, numriw, 'syice' ,      syice     (:,:)   ) 
    129       CALL iom_rstput( iter, nitrst, numriw, 'sxxice',      sxxice    (:,:)   ) 
    130       CALL iom_rstput( iter, nitrst, numriw, 'syyice',      syyice    (:,:)   ) 
    131       CALL iom_rstput( iter, nitrst, numriw, 'sxyice',      sxyice    (:,:)   ) 
    132       CALL iom_rstput( iter, nitrst, numriw, 'sxsn'  ,      sxsn      (:,:)   ) 
    133       CALL iom_rstput( iter, nitrst, numriw, 'sysn'  ,      sysn      (:,:)   ) 
    134       CALL iom_rstput( iter, nitrst, numriw, 'sxxsn' ,      sxxsn     (:,:)   ) 
    135       CALL iom_rstput( iter, nitrst, numriw, 'syysn' ,      syysn     (:,:)   ) 
    136       CALL iom_rstput( iter, nitrst, numriw, 'sxysn' ,      sxysn     (:,:)   ) 
    137       CALL iom_rstput( iter, nitrst, numriw, 'sxa'   ,      sxa       (:,:)   ) 
    138       CALL iom_rstput( iter, nitrst, numriw, 'sya'   ,      sya       (:,:)   ) 
    139       CALL iom_rstput( iter, nitrst, numriw, 'sxxa'  ,      sxxa      (:,:)   ) 
    140       CALL iom_rstput( iter, nitrst, numriw, 'syya'  ,      syya      (:,:)   ) 
    141       CALL iom_rstput( iter, nitrst, numriw, 'sxya'  ,      sxya      (:,:)   ) 
    142       CALL iom_rstput( iter, nitrst, numriw, 'sxc0'  ,      sxc0      (:,:)   ) 
    143       CALL iom_rstput( iter, nitrst, numriw, 'syc0'  ,      syc0      (:,:)   ) 
    144       CALL iom_rstput( iter, nitrst, numriw, 'sxxc0' ,      sxxc0     (:,:)   ) 
    145       CALL iom_rstput( iter, nitrst, numriw, 'syyc0' ,      syyc0     (:,:)   ) 
    146       CALL iom_rstput( iter, nitrst, numriw, 'sxyc0' ,      sxyc0     (:,:)   ) 
    147       CALL iom_rstput( iter, nitrst, numriw, 'sxc1'  ,      sxc1      (:,:)   ) 
    148       CALL iom_rstput( iter, nitrst, numriw, 'syc1'  ,      syc1      (:,:)   ) 
    149       CALL iom_rstput( iter, nitrst, numriw, 'sxxc1' ,      sxxc1     (:,:)   ) 
    150       CALL iom_rstput( iter, nitrst, numriw, 'syyc1' ,      syyc1     (:,:)   ) 
    151       CALL iom_rstput( iter, nitrst, numriw, 'sxyc1' ,      sxyc1     (:,:)   ) 
    152       CALL iom_rstput( iter, nitrst, numriw, 'sxc2'  ,      sxc2      (:,:)   ) 
    153       CALL iom_rstput( iter, nitrst, numriw, 'syc2'  ,      syc2      (:,:)   ) 
    154       CALL iom_rstput( iter, nitrst, numriw, 'sxxc2' ,      sxxc2     (:,:)   ) 
    155       CALL iom_rstput( iter, nitrst, numriw, 'syyc2' ,      syyc2     (:,:)   ) 
    156       CALL iom_rstput( iter, nitrst, numriw, 'sxyc2' ,      sxyc2     (:,:)   ) 
    157       CALL iom_rstput( iter, nitrst, numriw, 'sxst'  ,      sxst      (:,:)   ) 
    158       CALL iom_rstput( iter, nitrst, numriw, 'syst'  ,      syst      (:,:)   ) 
    159       CALL iom_rstput( iter, nitrst, numriw, 'sxxst' ,      sxxst     (:,:)   ) 
    160       CALL iom_rstput( iter, nitrst, numriw, 'syyst' ,      syyst     (:,:)   ) 
    161       CALL iom_rstput( iter, nitrst, numriw, 'sxyst' ,      sxyst     (:,:)   ) 
     110      CALL iom_rstput( iter, nitrst, numriw, 'hicif' , hicif (:,:)   )      ! prognostic variables  
     111      CALL iom_rstput( iter, nitrst, numriw, 'hsnif' , hsnif (:,:)   ) 
     112      CALL iom_rstput( iter, nitrst, numriw, 'frld'  , frld  (:,:)   ) 
     113      CALL iom_rstput( iter, nitrst, numriw, 'sist'  , sist  (:,:)   ) 
     114      CALL iom_rstput( iter, nitrst, numriw, 'tbif1' , tbif  (:,:,1) ) 
     115      CALL iom_rstput( iter, nitrst, numriw, 'tbif2' , tbif  (:,:,2) ) 
     116      CALL iom_rstput( iter, nitrst, numriw, 'tbif3' , tbif  (:,:,3) ) 
     117      CALL iom_rstput( iter, nitrst, numriw, 'u_ice' , u_ice (:,:)   ) 
     118      CALL iom_rstput( iter, nitrst, numriw, 'v_ice' , v_ice (:,:)   ) 
     119      CALL iom_rstput( iter, nitrst, numriw, 'qstoif', qstoif(:,:)   ) 
     120      CALL iom_rstput( iter, nitrst, numriw, 'fsbbq' , fsbbq (:,:)   ) 
     121      CALL iom_rstput( iter, nitrst, numriw, 'sxice' , sxice (:,:)   ) 
     122      CALL iom_rstput( iter, nitrst, numriw, 'syice' , syice (:,:)   ) 
     123      CALL iom_rstput( iter, nitrst, numriw, 'sxxice', sxxice(:,:)   ) 
     124      CALL iom_rstput( iter, nitrst, numriw, 'syyice', syyice(:,:)   ) 
     125      CALL iom_rstput( iter, nitrst, numriw, 'sxyice', sxyice(:,:)   ) 
     126      CALL iom_rstput( iter, nitrst, numriw, 'sxsn'  , sxsn  (:,:)   ) 
     127      CALL iom_rstput( iter, nitrst, numriw, 'sysn'  , sysn  (:,:)   ) 
     128      CALL iom_rstput( iter, nitrst, numriw, 'sxxsn' , sxxsn (:,:)   ) 
     129      CALL iom_rstput( iter, nitrst, numriw, 'syysn' , syysn (:,:)   ) 
     130      CALL iom_rstput( iter, nitrst, numriw, 'sxysn' , sxysn (:,:)   ) 
     131      CALL iom_rstput( iter, nitrst, numriw, 'sxa'   , sxa   (:,:)   ) 
     132      CALL iom_rstput( iter, nitrst, numriw, 'sya'   , sya   (:,:)   ) 
     133      CALL iom_rstput( iter, nitrst, numriw, 'sxxa'  , sxxa  (:,:)   ) 
     134      CALL iom_rstput( iter, nitrst, numriw, 'syya'  , syya  (:,:)   ) 
     135      CALL iom_rstput( iter, nitrst, numriw, 'sxya'  , sxya  (:,:)   ) 
     136      CALL iom_rstput( iter, nitrst, numriw, 'sxc0'  , sxc0  (:,:)   ) 
     137      CALL iom_rstput( iter, nitrst, numriw, 'syc0'  , syc0  (:,:)   ) 
     138      CALL iom_rstput( iter, nitrst, numriw, 'sxxc0' , sxxc0 (:,:)   ) 
     139      CALL iom_rstput( iter, nitrst, numriw, 'syyc0' , syyc0 (:,:)   ) 
     140      CALL iom_rstput( iter, nitrst, numriw, 'sxyc0' , sxyc0 (:,:)   ) 
     141      CALL iom_rstput( iter, nitrst, numriw, 'sxc1'  , sxc1  (:,:)   ) 
     142      CALL iom_rstput( iter, nitrst, numriw, 'syc1'  , syc1  (:,:)   ) 
     143      CALL iom_rstput( iter, nitrst, numriw, 'sxxc1' , sxxc1 (:,:)   ) 
     144      CALL iom_rstput( iter, nitrst, numriw, 'syyc1' , syyc1 (:,:)   ) 
     145      CALL iom_rstput( iter, nitrst, numriw, 'sxyc1' , sxyc1 (:,:)   ) 
     146      CALL iom_rstput( iter, nitrst, numriw, 'sxc2'  , sxc2  (:,:)   ) 
     147      CALL iom_rstput( iter, nitrst, numriw, 'syc2'  , syc2  (:,:)   ) 
     148      CALL iom_rstput( iter, nitrst, numriw, 'sxxc2' , sxxc2 (:,:)   ) 
     149      CALL iom_rstput( iter, nitrst, numriw, 'syyc2' , syyc2 (:,:)   ) 
     150      CALL iom_rstput( iter, nitrst, numriw, 'sxyc2' , sxyc2 (:,:)   ) 
     151      CALL iom_rstput( iter, nitrst, numriw, 'sxst'  , sxst  (:,:)   ) 
     152      CALL iom_rstput( iter, nitrst, numriw, 'syst'  , syst  (:,:)   ) 
     153      CALL iom_rstput( iter, nitrst, numriw, 'sxxst' , sxxst (:,:)   ) 
     154      CALL iom_rstput( iter, nitrst, numriw, 'syyst' , syyst (:,:)   ) 
     155      CALL iom_rstput( iter, nitrst, numriw, 'sxyst' , sxyst (:,:)   ) 
    162156       
    163157      IF( iter == nitrst ) THEN 
     
    224218      ENDIF 
    225219 
    226       CALL iom_get( numrir, jpdom_autoglo, 'qstoif'     , qstoif     )     
    227       CALL iom_get( numrir, jpdom_autoglo, 'fsbbq'      , fsbbq      )     
    228 #if ! defined key_lim2_vp 
    229       CALL iom_get( numrir, jpdom_autoglo, 'stress1_i'  , stress1_i  ) 
    230       CALL iom_get( numrir, jpdom_autoglo, 'stress2_i'  , stress2_i  ) 
    231       CALL iom_get( numrir, jpdom_autoglo, 'stress12_i' , stress12_i ) 
    232 #endif 
    233       CALL iom_get( numrir, jpdom_autoglo, 'sxice'      , sxice      ) 
    234       CALL iom_get( numrir, jpdom_autoglo, 'syice'      , syice      ) 
    235       CALL iom_get( numrir, jpdom_autoglo, 'sxxice'     , sxxice     ) 
    236       CALL iom_get( numrir, jpdom_autoglo, 'syyice'     , syyice     ) 
    237       CALL iom_get( numrir, jpdom_autoglo, 'sxyice'     , sxyice     ) 
    238       CALL iom_get( numrir, jpdom_autoglo, 'sxsn'       , sxsn       ) 
    239       CALL iom_get( numrir, jpdom_autoglo, 'sysn'       , sysn       ) 
    240       CALL iom_get( numrir, jpdom_autoglo, 'sxxsn'      , sxxsn      ) 
    241       CALL iom_get( numrir, jpdom_autoglo, 'syysn'      , syysn      ) 
    242       CALL iom_get( numrir, jpdom_autoglo, 'sxysn'      , sxysn      ) 
    243       CALL iom_get( numrir, jpdom_autoglo, 'sxa'        , sxa        ) 
    244       CALL iom_get( numrir, jpdom_autoglo, 'sya'        , sya        ) 
    245       CALL iom_get( numrir, jpdom_autoglo, 'sxxa'       , sxxa       ) 
    246       CALL iom_get( numrir, jpdom_autoglo, 'syya'       , syya       ) 
    247       CALL iom_get( numrir, jpdom_autoglo, 'sxya'       , sxya       ) 
    248       CALL iom_get( numrir, jpdom_autoglo, 'sxc0'       , sxc0       ) 
    249       CALL iom_get( numrir, jpdom_autoglo, 'syc0'       , syc0       ) 
    250       CALL iom_get( numrir, jpdom_autoglo, 'sxxc0'      , sxxc0      ) 
    251       CALL iom_get( numrir, jpdom_autoglo, 'syyc0'      , syyc0      ) 
    252       CALL iom_get( numrir, jpdom_autoglo, 'sxyc0'      , sxyc0      ) 
    253       CALL iom_get( numrir, jpdom_autoglo, 'sxc1'       , sxc1       ) 
    254       CALL iom_get( numrir, jpdom_autoglo, 'syc1'       , syc1       ) 
    255       CALL iom_get( numrir, jpdom_autoglo, 'sxxc1'      , sxxc1      ) 
    256       CALL iom_get( numrir, jpdom_autoglo, 'syyc1'      , syyc1      ) 
    257       CALL iom_get( numrir, jpdom_autoglo, 'sxyc1'      , sxyc1      ) 
    258       CALL iom_get( numrir, jpdom_autoglo, 'sxc2'       , sxc2       ) 
    259       CALL iom_get( numrir, jpdom_autoglo, 'syc2'       , syc2       ) 
    260       CALL iom_get( numrir, jpdom_autoglo, 'sxxc2'      , sxxc2      ) 
    261       CALL iom_get( numrir, jpdom_autoglo, 'syyc2'      , syyc2      ) 
    262       CALL iom_get( numrir, jpdom_autoglo, 'sxyc2'      , sxyc2      ) 
    263       CALL iom_get( numrir, jpdom_autoglo, 'sxst'       , sxst       ) 
    264       CALL iom_get( numrir, jpdom_autoglo, 'syst'       , syst       ) 
    265       CALL iom_get( numrir, jpdom_autoglo, 'sxxst'      , sxxst      ) 
    266       CALL iom_get( numrir, jpdom_autoglo, 'syyst'      , syyst      ) 
    267       CALL iom_get( numrir, jpdom_autoglo, 'sxyst'      , sxyst      ) 
     220      CALL iom_get( numrir, jpdom_autoglo, 'qstoif', qstoif )     
     221      CALL iom_get( numrir, jpdom_autoglo, 'fsbbq' , fsbbq  )     
     222      CALL iom_get( numrir, jpdom_autoglo, 'sxice' , sxice  ) 
     223      CALL iom_get( numrir, jpdom_autoglo, 'syice' , syice  ) 
     224      CALL iom_get( numrir, jpdom_autoglo, 'sxxice', sxxice ) 
     225      CALL iom_get( numrir, jpdom_autoglo, 'syyice', syyice ) 
     226      CALL iom_get( numrir, jpdom_autoglo, 'sxyice', sxyice ) 
     227      CALL iom_get( numrir, jpdom_autoglo, 'sxsn'  , sxsn   ) 
     228      CALL iom_get( numrir, jpdom_autoglo, 'sysn'  , sysn   ) 
     229      CALL iom_get( numrir, jpdom_autoglo, 'sxxsn' , sxxsn  ) 
     230      CALL iom_get( numrir, jpdom_autoglo, 'syysn' , syysn  ) 
     231      CALL iom_get( numrir, jpdom_autoglo, 'sxysn' , sxysn  ) 
     232      CALL iom_get( numrir, jpdom_autoglo, 'sxa'   , sxa    ) 
     233      CALL iom_get( numrir, jpdom_autoglo, 'sya'   , sya    ) 
     234      CALL iom_get( numrir, jpdom_autoglo, 'sxxa'  , sxxa   ) 
     235      CALL iom_get( numrir, jpdom_autoglo, 'syya'  , syya   ) 
     236      CALL iom_get( numrir, jpdom_autoglo, 'sxya'  , sxya   ) 
     237      CALL iom_get( numrir, jpdom_autoglo, 'sxc0'  , sxc0   ) 
     238      CALL iom_get( numrir, jpdom_autoglo, 'syc0'  , syc0   ) 
     239      CALL iom_get( numrir, jpdom_autoglo, 'sxxc0' , sxxc0  ) 
     240      CALL iom_get( numrir, jpdom_autoglo, 'syyc0' , syyc0  ) 
     241      CALL iom_get( numrir, jpdom_autoglo, 'sxyc0' , sxyc0  ) 
     242      CALL iom_get( numrir, jpdom_autoglo, 'sxc1'  , sxc1   ) 
     243      CALL iom_get( numrir, jpdom_autoglo, 'syc1'  , syc1   ) 
     244      CALL iom_get( numrir, jpdom_autoglo, 'sxxc1' , sxxc1  ) 
     245      CALL iom_get( numrir, jpdom_autoglo, 'syyc1' , syyc1  ) 
     246      CALL iom_get( numrir, jpdom_autoglo, 'sxyc1' , sxyc1  ) 
     247      CALL iom_get( numrir, jpdom_autoglo, 'sxc2'  , sxc2   ) 
     248      CALL iom_get( numrir, jpdom_autoglo, 'syc2'  , syc2   ) 
     249      CALL iom_get( numrir, jpdom_autoglo, 'sxxc2' , sxxc2  ) 
     250      CALL iom_get( numrir, jpdom_autoglo, 'syyc2' , syyc2  ) 
     251      CALL iom_get( numrir, jpdom_autoglo, 'sxyc2' , sxyc2  ) 
     252      CALL iom_get( numrir, jpdom_autoglo, 'sxst'  , sxst   ) 
     253      CALL iom_get( numrir, jpdom_autoglo, 'syst'  , syst   ) 
     254      CALL iom_get( numrir, jpdom_autoglo, 'sxxst' , sxxst  ) 
     255      CALL iom_get( numrir, jpdom_autoglo, 'syyst' , syyst  ) 
     256      CALL iom_get( numrir, jpdom_autoglo, 'sxyst' , sxyst  ) 
    268257       
    269258      CALL iom_close( numrir ) 
  • branches/devmercator2010/NEMO/LIM_SRC_2/limsbc_2.F90

    r2076 r2077  
    77   !!           02-07 (C. Ethe, G. Madec) re-writing F90 
    88   !!           06-07 (G. Madec) surface module 
    9    !!           09-05 (G.Garric) addition of the lim2_evp case 
    109   !!---------------------------------------------------------------------- 
    1110#if defined key_lim2 
     
    8988      REAL(wp) ::   zfrldu, zfrldv   ! lead fraction at U- & V-points 
    9089      REAL(wp) ::   zutau , zvtau    ! lead fraction at U- & V-points 
    91 !!!      REAL(wp) ::   zutaui , zvtaui  ! lead fraction at U- & V-points 
    9290      REAL(wp) ::   zu_io , zv_io    ! 2 components of the ice-ocean velocity 
    9391! interface 2D --> 3D 
     
    277275            DO ji = 2, jpim1   ! NO vector opt. 
    278276               ! ... components of ice-ocean stress at U and V-points  (from I-point values) 
    279 #if defined key_lim2_vp 
    280277               zutau  = 0.5 * ( ztio_u(ji+1,jj) + ztio_u(ji+1,jj+1) ) 
    281278               zvtau  = 0.5 * ( ztio_v(ji,jj+1) + ztio_v(ji+1,jj+1) ) 
    282 #else 
    283                zutau  = ztio_u(ji,jj) 
    284                zvtau  = ztio_v(ji,jj) 
    285 #endif 
    286279               ! ... open-ocean (lead) fraction at U- & V-points (from T-point values) 
    287280               zfrldu = 0.5 * ( frld(ji,jj) + frld(ji+1,jj  ) ) 
  • branches/devmercator2010/NEMO/LIM_SRC_2/limtrp_2.F90

    r2076 r2077  
    6767      !!        !  01-05 (G. Madec, R. Hordoir) opa norm 
    6868      !!   2.0  !  04-01 (G. Madec, C. Ethe)  F90, mpp 
    69       !!   3.3  !  09-05  (G.Garric) addition of the lim2_evp case 
    7069      !!--------------------------------------------------------------------- 
    7170      INTEGER, INTENT(in) ::   kt     ! number of iteration 
     
    108107         ! zvbord factor between 1 and 2 to take into account slip or no-slip boundary conditions.         
    109108         zvbord = 1.0 + ( 1.0 - bound ) 
    110 #if defined key_lim2_vp 
    111109         DO jj = 1, jpjm1 
    112110            DO ji = 1, jpim1   ! NO vector opt. 
     
    118116         CALL lbc_lnk( zui_u, 'U', -1. ) 
    119117         CALL lbc_lnk( zvi_v, 'V', -1. ) 
    120 #else 
    121         zui_u(:,:)=u_ice(:,:) 
    122         zvi_v(:,:)=v_ice(:,:) 
    123 #endif 
    124118 
    125119         ! CFL test for stability 
  • branches/devmercator2010/NEMO/LIM_SRC_3/limrhg.F90

    r2076 r2077  
    77   !!            3.0  !  2008-03  (M. Vancoppenolle) LIM3 
    88   !!             -   !  2008-11  (M. Vancoppenolle, S. Bouillon, Y. Aksenov) add surface tilt in ice rheolohy  
    9    !!             -   !  2009-05  (G.Garric) addition of the lim2_evp cas 
    109   !!---------------------------------------------------------------------- 
    11 #if defined key_lim3 || (  defined key_lim2 && ! defined key_lim2_vp ) 
     10#if defined key_lim3 
    1211   !!---------------------------------------------------------------------- 
    1312   !!   'key_lim3'                                      LIM3 sea-ice model 
     
    1918   USE par_oce 
    2019   USE dom_oce 
     20   USE dom_ice 
    2121   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2222   USE sbc_ice         ! Surface boundary condition: ice fields 
     23   USE ice 
     24   USE iceini 
    2325   USE lbclnk 
    2426   USE lib_mpp 
     
    2628   USE limitd_me 
    2729   USE prtctl          ! Print control 
    28 #if defined key_lim3 
    29    USE dom_ice 
    30    USE ice 
    31    USE iceini 
    32 #endif 
    33 #if defined key_lim2 && ! defined key_lim2_vp 
    34    USE dom_ice_2 
    35    USE ice_2 
    36    USE iceini_2 
    37 #endif 
     30 
    3831 
    3932   IMPLICIT NONE 
     
    187180         zresr                         !: Local error on velocity 
    188181 
    189 #if  defined key_lim2 && ! defined key_lim2_vp 
    190      vt_s => hsnm 
    191      vt_i => hicm 
    192      at_i(:,:) = 1. - frld(:,:) 
    193 #endif 
    194182      ! 
    195183      !------------------------------------------------------------------------------! 
     
    202190      u_ice2(:,:)  = 0.0 ; v_ice1(:,:)  = 0.0 
    203191      zdd(:,:)     = 0.0 ; zdt(:,:)     = 0.0 ; zds(:,:)     = 0.0 
    204 #if defined key_lim3 
     192 
    205193      ! Ice strength on T-points 
    206194      CALL lim_itd_me_icestrength(ridge_scheme_swi) 
    207 #endif 
    208195 
    209196      ! Ice mass and temp variables 
     
    213200         DO ji = 1 , jpi 
    214201            zc1(ji,jj)    = tms(ji,jj) * ( rhosn * vt_s(ji,jj) + rhoic * vt_i(ji,jj) ) 
    215 #if defined key_lim3 
    216202            zpresh(ji,jj) = tms(ji,jj) *  strength(ji,jj) / 2. 
    217 #else 
    218             zpresh(ji,jj) = tms(ji,jj) *  2. * pstar * hicm(ji,jj) * EXP( -c_rhg * frld(ji,jj) ) 
    219 #endif 
    220203            ! tmi = 1 where there is ice or on land 
    221204            tmi(ji,jj)    = 1.0 - ( 1.0 - MAX( 0.0 , SIGN ( 1.0 , vt_i(ji,jj) - & 
     
    286269               / ( e2t(ji,jj+1) + e2t(ji,jj) + epsd ) 
    287270            ! 
    288             ! Mass, coriolis coeff. and currents 
    289271            u_oce1(ji,jj)  = u_oce(ji,jj) 
    290272            v_oce2(ji,jj)  = v_oce(ji,jj) 
  • branches/devmercator2010/NEMO/OPA_SRC/DTA/dtasal.F90

    r2075 r2077  
    1313   USE oce             ! ocean dynamics and tracers 
    1414   USE dom_oce         ! ocean space and time domain 
     15   USE fldread         ! read input fields 
    1516   USE in_out_manager  ! I/O manager 
    1617   USE phycst          ! physical constants 
     
    2728   !! * Shared module variables 
    2829   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasal = .TRUE.    !: salinity data flag 
    29    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: 
    30       s_dta       !: salinity data at given time-step 
     30   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   s_dta    !: salinity data at given time-step 
    3131 
    3232   !! * Module variables 
    33    INTEGER ::   & 
    34       numsdt,           &  !: logical unit for data salinity 
    35       nsal1, nsal2         ! first and second record used 
    36    REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
    37       saldta    ! salinity data at two consecutive times 
     33   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sal       ! structure of input SST (file informations, fields read) 
    3834 
    3935   !! * Substitutions 
     
    5248 
    5349   SUBROUTINE dta_sal( kt ) 
    54      !!---------------------------------------------------------------------- 
    55      !!                   ***  ROUTINE dta_sal  *** 
    56      !!         
    57      !! ** Purpose :   Reads monthly salinity data 
    58      !!              
    59      !! ** Method  : - Read on unit numsdt the monthly salinity data interpo- 
    60      !!     lated onto the model grid. 
    61      !!              - At each time step, a linear interpolation is applied 
    62      !!     between two monthly values. 
    63      !! 
    64      !! History : 
    65      !!        !  91-03  ()  Original code 
    66      !!        !  92-07  (M. Imbard) 
    67      !!   9.0  !  02-06  (G. Madec)  F90: Free form and module  
    68      !!---------------------------------------------------------------------- 
    69      !! * Modules used 
    70      USE iom 
    71       
    72      !! * Arguments 
    73      INTEGER, INTENT(in) ::   kt             ! ocean time step 
    74       
    75      !! * Local declarations 
    76       
    77      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies 
    78      INTEGER ::   & 
    79           imois, iman, i15, ik           ! temporary integers 
    80 #  if defined key_tradmp 
    81      INTEGER ::   & 
     50      !!---------------------------------------------------------------------- 
     51      !!                   ***  ROUTINE dta_sal  *** 
     52      !!         
     53      !! ** Purpose :   Reads monthly salinity data 
     54      !!              
     55      !! ** Method  : - Read on unit numsdt the monthly salinity data interpo- 
     56      !!     lated onto the model grid. 
     57      !!              - At each time step, a linear interpolation is applied 
     58      !!     between two monthly values. 
     59      !! 
     60      !! History : 
     61      !!        !  91-03  ()  Original code 
     62      !!        !  92-07  (M. Imbard) 
     63      !!   9.0  !  02-06  (G. Madec)  F90: Free form and module  
     64      !!---------------------------------------------------------------------- 
     65      
     66      !! * Arguments 
     67      INTEGER, INTENT(in) ::   kt             ! ocean time step 
     68       
     69      !! * Local declarations 
     70      
     71      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies 
     72      INTEGER ::   & 
     73           imois, iman, i15, ik           ! temporary integers 
     74      INTEGER            :: ierror 
     75#if defined key_tradmp 
     76      INTEGER ::   & 
    8277          il0, il1, ii0, ii1, ij0, ij1   ! temporary integers          
    83 # endif 
    84      REAL(wp) ::   zxy, zl 
     78#endif 
     79      REAL(wp) ::   zxy, zl 
    8580#if defined key_orca_lev10 
    86      REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: zsal 
    87      INTEGER   :: ikr, ikw, ikt, jjk 
    88      REAL(wp)  :: zfac 
    89 #endif 
    90      REAL(wp), DIMENSION(jpk,2) ::   & 
     81      INTEGER   :: ikr, ikw, ikt, jjk 
     82      REAL(wp)  :: zfac 
     83#endif 
     84      REAL(wp), DIMENSION(jpk) ::   & 
    9185          zsaldta            ! auxiliary array for interpolation 
    92      !!---------------------------------------------------------------------- 
    93       
    94      ! 0. Initialization 
    95      ! ----------------- 
    96       
    97      iman  = INT( raamo ) 
    98 !!! better but change the results     i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 
    99      i15   = nday / 16 
    100      imois = nmonth + i15 - 1 
    101      IF( imois == 0 ) imois = iman 
    102       
    103      ! 1. First call kt=nit000 
    104      ! ----------------------- 
    105       
    106      IF( kt == nit000 ) THEN 
    107          
    108         nsal1 = 0   ! initializations 
    109         IF(lwp) WRITE(numout,*) ' dta_sal : monthly salinity data in NetCDF file' 
    110         CALL iom_open ( 'data_1m_salinity_nomask', numsdt )  
    111          
    112      ENDIF 
    113       
    114       
    115      ! 2. Read monthly file 
    116      ! ------------------- 
    117       
    118      IF( kt == nit000 .OR. imois /= nsal1 ) THEN 
    119          
    120         ! 2.1 Calendar computation 
    121          
    122         nsal1 = imois        ! first file record used  
    123         nsal2 = nsal1 + 1    ! last  file record used 
    124         nsal1 = MOD( nsal1, iman ) 
    125         IF( nsal1 == 0 ) nsal1 = iman 
    126         nsal2 = MOD( nsal2, iman ) 
    127         IF( nsal2 == 0 ) nsal2 = iman 
    128         IF(lwp) WRITE(numout,*) 'first record file used nsal1 ', nsal1 
    129         IF(lwp) WRITE(numout,*) 'last  record file used nsal2 ', nsal2 
    130          
    131         ! 2.3 Read monthly salinity data Levitus  
     86      CHARACTER(len=100) :: cn_dir          ! Root directory for location of ssr files 
     87      TYPE(FLD_N)        :: sn_sal 
     88      LOGICAL , SAVE     :: linit_sal = .FALSE. 
     89      !!---------------------------------------------------------------------- 
     90      NAMELIST/namdta_sal/cn_dir,sn_sal 
     91      
     92      ! 1. Initialization 
     93      ! ----------------------- 
     94      
     95      IF( kt == nit000 .AND. ( .NOT. linit_sal ) ) THEN 
     96         
     97         !                         ! set file information 
     98         cn_dir = './'             ! directory in which the model is executed 
     99         ! ... default values (NB: frequency positive => hours, negative => months) 
     100         !            !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
     101         !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
     102         sn_sal = FLD_N( 'salinity',  -1.  ,  'vosaline',  .false.   , .true.  ,  'monthly'  , ''       , ''         ) 
     103 
     104         REWIND ( numnam )         ! ... read in namlist namdta_sal  
     105         READ( numnam, namdta_sal )  
     106 
     107         IF(lwp) THEN              ! control print 
     108            WRITE(numout,*) 
     109            WRITE(numout,*) 'dta_sal : Salinity Climatology ' 
     110            WRITE(numout,*) '~~~~~~~ ' 
     111         ENDIF 
     112         ALLOCATE( sf_sal(1), STAT=ierror ) 
     113         IF( ierror > 0 ) THEN 
     114             CALL ctl_stop( 'dta_sal: unable to allocate sf_sal structure' )   ;   RETURN 
     115         ENDIF 
     116         ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk) ) 
     117         ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2) ) 
     118 
     119         ! fill sf_sal with sn_sal and control print 
     120         CALL fld_fill( sf_sal, (/ sn_sal /), cn_dir, 'dta_sal', 'Salinity data', 'namdta_sal' ) 
     121         linit_sal = .TRUE.         
     122      ENDIF 
     123      
     124      
     125      ! 2. Read monthly file 
     126      ! ------------------- 
     127      
     128      CALL fld_read( kt, 1, sf_sal ) 
     129 
     130      IF( lwp .AND. kt==nn_it000 ) THEN 
     131         WRITE(numout,*) 
     132         WRITE(numout,*) ' read Levitus salinity ok' 
     133         WRITE(numout,*) 
     134      ENDIF 
     135 
     136#if defined key_tradmp 
     137      IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN 
     138    
     139         !                                        ! ======================= 
     140         !                                        !  ORCA_R2 configuration 
     141         !                                        ! ======================= 
     142         ij0 = 101   ;   ij1 = 109 
     143         ii0 = 141   ;   ii1 = 155    
     144         DO jj = mj0(ij0), mj1(ij1)                  ! Reduced salinity in the Alboran Sea 
     145            DO ji = mi0(ii0), mi1(ii1) 
     146               sf_sal(1)%fnow(ji,jj,13:13) = sf_sal(1)%fnow(ji,jj,13:13) - 0.15 
     147               sf_sal(1)%fnow(ji,jj,14:15) = sf_sal(1)%fnow(ji,jj,14:15) - 0.25 
     148               sf_sal(1)%fnow(ji,jj,16:17) = sf_sal(1)%fnow(ji,jj,16:17) - 0.30 
     149               sf_sal(1)%fnow(ji,jj,18:25) = sf_sal(1)%fnow(ji,jj,18:25) - 0.35 
     150            END DO 
     151         END DO 
     152 
     153         IF( n_cla == 1 ) THEN  
     154            !                                         ! New salinity profile at Gibraltar 
     155            il0 = 138   ;   il1 = 138    
     156            ij0 = 101   ;   ij1 = 102 
     157            ii0 = 139   ;   ii1 = 139    
     158            DO jl = mi0(il0), mi1(il1) 
     159               DO jj = mj0(ij0), mj1(ij1) 
     160                  DO ji = mi0(ii0), mi1(ii1) 
     161                        sf_sal(1)%fnow(ji,jj,:) = sf_sal(1)%fnow(jl,jj,:) 
     162                  END DO 
     163               END DO 
     164            END DO 
     165            !                                         ! New salinity profile at Bab el Mandeb 
     166            il0 = 164   ;   il1 = 164    
     167            ij0 =  87   ;   ij1 =  88 
     168            ii0 = 161   ;   ii1 = 163    
     169            DO jl = mi0(il0), mi1(il1) 
     170               DO jj = mj0(ij0), mj1(ij1) 
     171                  DO ji = mi0(ii0), mi1(ii1) 
     172                     sf_sal(1)%fnow(ji,jj,:) = sf_sal(1)%fnow(jl,jj,:) 
     173                  END DO 
     174               END DO 
     175            END DO 
     176            ! 
     177         ENDIF 
     178            ! 
     179      ENDIF 
     180#endif    
    132181         
    133182#if defined key_orca_lev10 
    134         if (ln_zps) stop 
    135         zsal(:,:,:,:) = 0. 
    136         CALL iom_get (numsdt,jpdom_data,'vosaline',zsal(:,:,:,1),nsal1) 
    137         CALL iom_get (numsdt,jpdom_data,'vosaline',zsal(:,:,:,2),nsal2) 
     183      DO jjk = 1, 5 
     184         s_dta(:,:,jjk) = sf_sal(1)%fnow(:,:,1) 
     185      ENDDO 
     186      DO jk = 1, jpk-20,10 
     187         ikr =  INT(jk/10) + 1 
     188         ikw =  (ikr-1) *10 + 1 
     189         ikt =  ikw + 5 
     190         DO jjk=ikt,ikt+9 
     191            zfac = ( gdept_0(jjk   ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 
     192            s_dta(:,:,jjk) = sf_sal(1)%fnow(:,:,ikr) + ( sf_sal(1)%fnow(:,:,ikr+1) - sf_sal(1)%fnow(:,:,ikr) ) * zfac 
     193         END DO 
     194      END DO 
     195      DO jjk = jpk-5, jpk 
     196         s_dta(:,:,jjk) = sf_sal(1)%fnow(:,:,jpkdta-1) 
     197      END DO 
     198      ! fill the overlap areas 
     199      CALL lbc_lnk (s_dta(:,:,:),'Z',-999.,'no0')         
    138200#else 
    139         CALL iom_get (numsdt,jpdom_data,'vosaline',saldta(:,:,:,1),nsal1) 
    140         CALL iom_get (numsdt,jpdom_data,'vosaline',saldta(:,:,:,2),nsal2) 
    141 #endif 
    142          
    143         IF(lwp) THEN 
    144            WRITE(numout,*) 
    145            WRITE(numout,*) ' read Levitus salinity ok' 
    146            WRITE(numout,*) 
    147         ENDIF 
    148          
    149 #if defined key_tradmp 
    150         IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN 
     201      s_dta(:,:,:)=sf_sal(1)%fnow(:,:,:) 
     202#endif 
     203         
     204      IF( ln_sco ) THEN 
     205         DO jj = 1, jpj                  ! interpolation of salinites 
     206            DO ji = 1, jpi 
     207               DO jk = 1, jpk 
     208                  zl=fsdept_0(ji,jj,jk) 
     209                  IF(zl < gdept_0(1)  ) zsaldta(jk) =  s_dta(ji,jj,1    )  
     210                  IF(zl > gdept_0(jpk)) zsaldta(jk) =  s_dta(ji,jj,jpkm1)  
     211                  DO jkk = 1, jpkm1 
     212                     IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 
     213                          zsaldta(jk) = s_dta(ji,jj,jkk)                                 & 
     214                                     &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))      & 
     215                                     &                              *(s_dta(ji,jj,jkk+1) - s_dta(ji,jj,jkk)) 
     216                     ENDIF 
     217                  END DO 
     218               END DO 
     219               DO jk = 1, jpkm1 
     220                  s_dta(ji,jj,jk) = zsaldta(jk)  
     221               END DO 
     222               s_dta(ji,jj,jpk) = 0.0  
     223            END DO 
     224         END DO 
    151225            
    152            !                                        ! ======================= 
    153            !                                        !  ORCA_R2 configuration 
    154            !                                        ! ======================= 
    155            ij0 = 101   ;   ij1 = 109 
    156            ii0 = 141   ;   ii1 = 155    
    157            DO jj = mj0(ij0), mj1(ij1)                  ! Reduced salinity in the Alboran Sea 
    158               DO ji = mi0(ii0), mi1(ii1) 
    159 #if defined key_orca_lev10 
    160                  zsal  (ji,jj,13:13,:) = zsal  (ji,jj,13:13,:) - 0.15 
    161                  zsal  (ji,jj,14:15,:) = zsal  (ji,jj,14:15,:) - 0.25 
    162                  zsal  (ji,jj,16:17,:) = zsal  (ji,jj,16:17,:) - 0.30 
    163                  zsal  (ji,jj,18:25,:) = zsal  (ji,jj,18:25,:) - 0.35 
    164 #else 
    165                  saldta(ji,jj,13:13,:) = saldta(ji,jj,13:13,:) - 0.15 
    166                  saldta(ji,jj,14:15,:) = saldta(ji,jj,14:15,:) - 0.25 
    167                  saldta(ji,jj,16:17,:) = saldta(ji,jj,16:17,:) - 0.30 
    168                  saldta(ji,jj,18:25,:) = saldta(ji,jj,18:25,:) - 0.35 
    169 #endif 
    170               END DO 
    171            END DO 
    172  
    173            IF( n_cla == 1 ) THEN  
    174               !                                         ! New salinity profile at Gibraltar 
    175               il0 = 138   ;   il1 = 138    
    176               ij0 = 101   ;   ij1 = 102 
    177               ii0 = 139   ;   ii1 = 139    
    178               DO jl = mi0(il0), mi1(il1) 
    179                  DO jj = mj0(ij0), mj1(ij1) 
    180                     DO ji = mi0(ii0), mi1(ii1) 
    181 #if defined key_orca_lev10 
    182                        zsal  (ji,jj,:,:) = zsal  (jl,jj,:,:) 
    183 #else 
    184                        saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 
    185 #endif 
    186                     END DO 
    187                  END DO 
    188               END DO 
    189               !                                         ! New salinity profile at Bab el Mandeb 
    190               il0 = 164   ;   il1 = 164    
    191               ij0 =  87   ;   ij1 =  88 
    192               ii0 = 161   ;   ii1 = 163    
    193               DO jl = mi0(il0), mi1(il1) 
    194                  DO jj = mj0(ij0), mj1(ij1) 
    195                     DO ji = mi0(ii0), mi1(ii1) 
    196 #if defined key_orca_lev10 
    197                        zsal  (ji,jj,:,:) = zsal  (jl,jj,:,:) 
    198 #else 
    199                        saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 
    200 #endif 
    201                     END DO 
    202                  END DO 
    203               END DO 
    204               ! 
    205            ENDIF 
    206            ! 
    207         ENDIF 
    208 #endif    
    209          
    210 #if defined key_orca_lev10 
    211         !  interpolate from 31 to 301 level the zsal field result in saldta 
    212         DO jl = 1, 2 
    213            DO jjk = 1, 5 
    214               saldta(:,:,jjk,jl) = zsal(:,:,1,jl) 
    215            ENDDO 
    216            DO jk = 1, jpk - 20, 10 
    217               ikr = INT( jk / 10 ) + 1 
    218               ikw = (ikr-1) * 10 + 1 
    219               ikt = ikw + 5 
    220               DO jjk = ikt , ikt + 9 
    221                  zfac = ( gdept_0(jjk) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 
    222                  saldta(:,:,jjk,jl) = zsal(:,:,ikr,jl) + ( zsal(:,:,ikr+1,jl) - zsal(:,:,ikr,jl) ) * zfac 
    223               END DO 
    224            END DO 
    225            DO jjk = jpk-5, jpk 
    226               saldta(:,:,jjk,jl) = zsal(:,:,jpkdta-1,jl) 
    227            END DO 
    228            ! fill the overlap areas 
    229            CALL lbc_lnk (saldta(:,:,:,jl),'Z',-999.,'no0') 
    230         END DO 
    231          
    232 #endif 
    233          
    234         IF( ln_sco ) THEN 
    235            DO jl = 1, 2 
    236               DO jj = 1, jpj                  ! interpolation of salinites 
    237                  DO ji = 1, jpi 
    238                     DO jk = 1, jpk 
    239                        zl=fsdept_0(ji,jj,jk) 
    240                        IF(zl <  gdept_0(1)) zsaldta(jk,jl) =  saldta(ji,jj,1,jl) 
    241                        IF(zl >  gdept_0(jpk)) zsaldta(jk,jl) =  saldta(ji,jj,jpkm1,jl) 
    242                        DO jkk = 1, jpkm1 
    243                           IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 
    244                              zsaldta(jk,jl) = saldta(ji,jj,jkk,jl)                                  & 
    245                                   &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))       & 
    246                                   &                              *(saldta(ji,jj,jkk+1,jl) - saldta(ji,jj,jkk,jl)) 
    247                           ENDIF 
    248                        END DO 
    249                     END DO 
    250                     DO jk = 1, jpkm1 
    251                        saldta(ji,jj,jk,jl) = zsaldta(jk,jl) 
    252                     END DO 
    253                     saldta(ji,jj,jpk,jl) = 0.0 
    254                  END DO 
    255               END DO 
    256            END DO 
    257             
    258            IF(lwp) WRITE(numout,*) 
    259            IF(lwp) WRITE(numout,*) ' Levitus salinity data interpolated to s-coordinate' 
    260            IF(lwp) WRITE(numout,*) 
    261             
    262         ELSE 
    263            !                                  ! Mask 
    264            DO jl = 1, 2 
    265               saldta(:,:,:,jl) = saldta(:,:,:,jl)*tmask(:,:,:) 
    266               saldta(:,:,jpk,jl) = 0. 
    267               IF( ln_zps ) THEN               ! z-coord. partial steps 
    268                  DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
    269                     DO ji = 1, jpi 
    270                        ik = mbathy(ji,jj) - 1 
    271                        IF( ik > 2 ) THEN 
    272                           zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 
    273                           saldta(ji,jj,ik,jl) = (1.-zl) * saldta(ji,jj,ik,jl) +zl * saldta(ji,jj,ik-1,jl) 
    274                        ENDIF 
    275                     END DO 
    276                  END DO 
    277               ENDIF 
    278            END DO 
    279         ENDIF 
    280          
    281          
    282         IF(lwp) THEN 
    283            WRITE(numout,*)' salinity Levitus month ',nsal1,nsal2 
    284            WRITE(numout,*) 
    285            WRITE(numout,*) ' Levitus month = ',nsal1,'  level = 1' 
    286            CALL prihre(saldta(:,:,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
    287            WRITE(numout,*) ' Levitus month = ',nsal1,'  level = ',jpk/2 
    288            CALL prihre(saldta(:,:,jpk/2,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
    289            WRITE(numout,*) ' Levitus month = ',nsal1,'  level = ',jpkm1 
    290            CALL prihre(saldta(:,:,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
    291         ENDIF 
    292      ENDIF 
    293       
    294       
    295      ! 3. At every time step compute salinity data 
    296      ! ------------------------------------------- 
    297       
    298      zxy = FLOAT(nday + 15 - 30*i15)/30. 
    299      s_dta(:,:,:) = ( 1.- zxy ) * saldta(:,:,:,1) + zxy * saldta(:,:,:,2) 
    300       
    301      ! Close the file 
    302      ! -------------- 
    303       
    304      IF( kt == nitend )   CALL iom_close (numsdt) 
     226         IF( lwp .AND. kt==nn_it000 ) THEN 
     227            WRITE(numout,*) 
     228            WRITE(numout,*) ' Levitus salinity data interpolated to s-coordinate' 
     229            WRITE(numout,*) 
     230         ENDIF 
     231 
     232      ELSE 
     233         !                                  ! Mask 
     234         s_dta(:,:,:) = s_dta(:,:,:) * tmask(:,:,:) 
     235         s_dta(:,:,jpk) = 0.  
     236         IF( ln_zps ) THEN               ! z-coord. partial steps 
     237            DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
     238               DO ji = 1, jpi 
     239                  ik = mbathy(ji,jj) - 1 
     240                  IF( ik > 2 ) THEN 
     241                     zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 
     242                     s_dta(ji,jj,ik) = (1.-zl) * s_dta(ji,jj,ik) + zl * s_dta(ji,jj,ik-1) 
     243                  ENDIF 
     244               END DO 
     245            END DO 
     246         ENDIF 
     247      ENDIF 
     248         
     249      IF( lwp .AND. kt==nn_it000 ) THEN 
     250         WRITE(numout,*)' salinity Levitus ' 
     251         WRITE(numout,*) 
     252         WRITE(numout,*)'  level = 1' 
     253         CALL prihre(s_dta(:,:,1),    jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
     254         WRITE(numout,*)'  level = ',jpk/2 
     255         CALL prihre(s_dta(:,:,jpk/2),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)            
     256         WRITE(numout,*) '  level = ',jpkm1 
     257         CALL prihre(s_dta(:,:,jpkm1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
     258      ENDIF 
    305259 
    306260   END SUBROUTINE dta_sal 
  • branches/devmercator2010/NEMO/OPA_SRC/DTA/dtatem.F90

    r2075 r2077  
    1313   USE oce             ! ocean dynamics and tracers 
    1414   USE dom_oce         ! ocean space and time domain 
     15   USE fldread         ! read input fields 
    1516   USE in_out_manager  ! I/O manager 
    1617   USE phycst          ! physical constants 
     
    2627   !! * Shared module variables 
    2728   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .TRUE.   !: temperature data flag 
    28    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: 
    29       t_dta             !: temperature data at given time-step 
     29   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::  t_dta    !: temperature data at given time-step 
    3030 
    3131   !! * Module variables 
    32    INTEGER ::   & 
    33       numtdt,        &  !: logical unit for data temperature 
    34       ntem1, ntem2  ! first and second record used 
    35    REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
    36       temdta            ! temperature data at two consecutive times 
     32   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tem      ! structure of input SST (file informations, fields read) 
    3733 
    3834   !! * Substitutions 
     
    7369      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module 
    7470      !!---------------------------------------------------------------------- 
    75       !! * Modules used 
    76       USE iom 
    77  
    7871      !! * Arguments 
    7972      INTEGER, INTENT( in ) ::   kt     ! ocean time-step 
    8073 
    8174      !! * Local declarations 
    82       INTEGER ::   ji, jj, jl, jk, jkk       ! dummy loop indicies 
     75      INTEGER ::   ji, jj, jk, jl, jkk       ! dummy loop indicies 
    8376      INTEGER ::   & 
    84          imois, iman, i15 , ik      ! temporary integers 
    85 #  if defined key_tradmp 
     77        imois, iman, i15 , ik      ! temporary integers 
     78      INTEGER            :: ierror 
     79#if defined key_tradmp 
    8680      INTEGER ::   & 
    8781         il0, il1, ii0, ii1, ij0, ij1   ! temporary integers 
    88 # endif 
     82#endif 
    8983      REAL(wp) ::   zxy, zl 
    9084#if defined key_orca_lev10 
    91       REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: ztem 
     85      !!!REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: ztem 
    9286      INTEGER   :: ikr, ikw, ikt, jjk  
    9387      REAL(wp)  :: zfac 
    9488#endif 
    95       REAL(wp), DIMENSION(jpk,2) ::   & 
     89      REAL(wp), DIMENSION(jpk) ::   & 
    9690         ztemdta            ! auxiliary array for interpolation 
     91      CHARACTER(len=100) :: cn_dir          ! Root directory for location of ssr files 
     92      TYPE(FLD_N)        :: sn_tem 
     93      LOGICAL , SAVE     :: linit_tem = .FALSE. 
    9794      !!---------------------------------------------------------------------- 
    98        
    99       ! 0. Initialization 
    100       ! ----------------- 
    101        
    102       iman  = INT( raamo ) 
    103 !!! better but change the results     i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 
    104       i15   = nday / 16 
    105       imois = nmonth + i15 - 1 
    106       IF( imois == 0 ) imois = iman 
    107        
    108       ! 1. First call kt=nit000 
     95      NAMELIST/namdta_tem/cn_dir,sn_tem 
     96  
     97      ! 1. Initialization  
    10998      ! ----------------------- 
    11099       
    111       IF( kt == nit000 ) THEN 
    112           
    113          ntem1= 0   ! initializations 
    114          IF(lwp) WRITE(numout,*) ' dta_tem : Levitus monthly fields' 
    115          CALL iom_open ( 'data_1m_potential_temperature_nomask', numtdt )  
    116           
    117       ENDIF 
    118        
     100      IF( kt == nit000 .AND. (.NOT. linit_tem ) ) THEN 
     101 
     102         !                   ! set file information 
     103         cn_dir = './'       ! directory in which the model is executed 
     104         ! ... default values (NB: frequency positive => hours, negative => months) 
     105         !            !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
     106         !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
     107         sn_tem = FLD_N( 'temperature',  -1.  ,  'votemper',  .false.   , .true.  ,  'yearly'  , ''       , ''         ) 
     108 
     109         REWIND( numnam )         ! ... read in namlist namdta_tem  
     110         READ( numnam, namdta_tem )  
     111 
     112         IF(lwp) THEN              ! control print 
     113            WRITE(numout,*) 
     114            WRITE(numout,*) 'dta_tem : Temperature Climatology ' 
     115            WRITE(numout,*) '~~~~~~~ ' 
     116         ENDIF 
     117         ALLOCATE( sf_tem(1), STAT=ierror ) 
     118         IF( ierror > 0 ) THEN 
     119             CALL ctl_stop( 'dta_tem: unable to allocate sf_tem structure' )   ;   RETURN 
     120         ENDIF 
     121 
     122#if defined key_orca_lev10 
     123         ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpkdta)   ) 
     124         ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpkdta,2) ) 
     125#else 
     126         ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk)   ) 
     127         ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) ) 
     128#endif 
     129         ! fill sf_tem with sn_tem and control print 
     130         CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' ) 
     131         linit_tem = .TRUE. 
     132 
     133      ENDIF 
    119134       
    120135      ! 2. Read monthly file 
    121136      ! ------------------- 
    122        
    123       IF( kt == nit000 .OR. imois /= ntem1 ) THEN 
    124           
    125          ! Calendar computation 
    126           
    127          ntem1 = imois        ! first file record used  
    128          ntem2 = ntem1 + 1    ! last  file record used 
    129          ntem1 = MOD( ntem1, iman ) 
    130          IF( ntem1 == 0 )   ntem1 = iman 
    131          ntem2 = MOD( ntem2, iman ) 
    132          IF( ntem2 == 0 )   ntem2 = iman 
    133          IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1 
    134          IF(lwp) WRITE(numout,*) 'last  record file used ntem2 ', ntem2 
    135           
    136          ! Read monthly temperature data Levitus  
    137           
    138 #if defined key_orca_lev10 
    139          if (ln_zps) stop 
    140          ztem(:,:,:,:) = 0. 
    141          CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,1),ntem1) 
    142          CALL iom_get (numtdt,jpdom_data,'votemper',ztem(:,:,:,2),ntem2) 
    143 #else          
    144          CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,1),ntem1) 
    145          CALL iom_get (numtdt,jpdom_data,'votemper',temdta(:,:,:,2),ntem2) 
    146 #endif 
    147           
    148          IF(lwp) WRITE(numout,*) 
    149          IF(lwp) WRITE(numout,*) ' read Levitus temperature ok' 
    150          IF(lwp) WRITE(numout,*) 
     137          
     138      CALL fld_read( kt, 1, sf_tem ) 
     139        
     140      IF( lwp .AND. kt==nn_it000 )THEN  
     141         WRITE(numout,*) 
     142         WRITE(numout,*) ' read Levitus temperature ok' 
     143         WRITE(numout,*) 
     144      ENDIF 
    151145          
    152146#if defined key_tradmp 
    153          IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN 
    154              
    155             !                                        ! ======================= 
    156             !                                        !  ORCA_R2 configuration 
    157             !                                        ! =======================  
    158             ij0 = 101   ;   ij1 = 109 
    159             ii0 = 141   ;   ii1 = 155 
    160             DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea 
    161                DO ji = mi0(ii0), mi1(ii1) 
    162 #if defined key_orca_lev10 
    163                   ztem(  ji,jj, 13:13 ,:) = ztem  (ji,jj, 13:13 ,:) - 0.20 
    164                   ztem  (ji,jj, 14:15 ,:) = ztem  (ji,jj, 14:15 ,:) - 0.35 
    165                   ztem  (ji,jj, 16:25 ,:) = ztem  (ji,jj, 16:25 ,:) - 0.40 
     147      IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN 
     148             
     149         !                                        ! ======================= 
     150         !                                        !  ORCA_R2 configuration 
     151         !                                        ! =======================  
     152         ij0 = 101   ;   ij1 = 109 
     153         ii0 = 141   ;   ii1 = 155 
     154         DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea 
     155            DO ji = mi0(ii0), mi1(ii1) 
     156               sf_tem(1)%fnow(ji,jj, 13:13 ) = sf_tem(1)%fnow(ji,jj, 13:13 ) - 0.20 
     157               sf_tem(1)%fnow(ji,jj, 14:15 ) = sf_tem(1)%fnow(ji,jj, 14:15 ) - 0.35   
     158               sf_tem(1)%fnow(ji,jj, 16:25 ) = sf_tem(1)%fnow(ji,jj, 16:25 ) - 0.40 
     159            END DO 
     160         END DO 
     161             
     162         IF( n_cla == 1 ) THEN  
     163            !                                         ! New temperature profile at Gibraltar 
     164            il0 = 138   ;   il1 = 138 
     165            ij0 = 101   ;   ij1 = 102 
     166            ii0 = 139   ;   ii1 = 139 
     167            DO jl = mi0(il0), mi1(il1) 
     168               DO jj = mj0(ij0), mj1(ij1) 
     169                  DO ji = mi0(ii0), mi1(ii1) 
     170                     sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:) 
     171                  END DO 
     172               END DO 
     173            END DO 
     174            !                                         ! New temperature profile at Bab el Mandeb 
     175            il0 = 164   ;   il1 = 164 
     176            ij0 =  87   ;   ij1 =  88 
     177            ii0 = 161   ;   ii1 = 163 
     178            DO jl = mi0(il0), mi1(il1) 
     179               DO jj = mj0(ij0), mj1(ij1) 
     180                  DO ji = mi0(ii0), mi1(ii1) 
     181                     sf_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:) 
     182                  END DO 
     183               END DO 
     184            END DO 
     185            ! 
     186         ELSE 
     187            !                                         ! Reduced temperature at Red Sea 
     188            ij0 =  87   ;   ij1 =  96 
     189            ii0 = 148   ;   ii1 = 160 
     190            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0 
     191            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5 
     192            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0 
     193         ENDIF 
     194            ! 
     195      ENDIF 
     196#endif 
     197          
     198#if defined key_orca_lev10 
     199      DO jjk = 1, 5 
     200         t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,1) 
     201      END DO 
     202      DO jk = 1, jpk-20,10 
     203         ik = jk+5 
     204         ikr =  INT(jk/10) + 1 
     205         ikw =  (ikr-1) *10 + 1 
     206         ikt =  ikw + 5 
     207         DO jjk=ikt,ikt+9 
     208            zfac = ( gdept_0(jjk   ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 
     209            t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,ikr) + ( sf_tem(1)%fnow(:,:,ikr+1) - sf_tem(1)%fnow(:,:,ikr) ) * zfac 
     210         END DO 
     211      END DO 
     212      DO jjk = jpk-5, jpk 
     213         t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,jpkdta-1) 
     214      END DO 
     215      ! fill the overlap areas 
     216      CALL lbc_lnk (t_dta(:,:,:),'Z',-999.,'no0') 
    166217#else 
    167                   temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20 
    168                   temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35 
    169                   temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40 
    170 #endif 
    171                END DO 
    172             END DO 
    173              
    174             IF( n_cla == 1 ) THEN  
    175                !                                         ! New temperature profile at Gibraltar 
    176                il0 = 138   ;   il1 = 138 
    177                ij0 = 101   ;   ij1 = 102 
    178                ii0 = 139   ;   ii1 = 139 
    179                DO jl = mi0(il0), mi1(il1) 
    180                   DO jj = mj0(ij0), mj1(ij1) 
    181                      DO ji = mi0(ii0), mi1(ii1) 
    182 #if defined key_orca_lev10 
    183                         ztem  (ji,jj,:,:) = ztem  (jl,jj,:,:) 
    184 #else 
    185                         temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 
    186 #endif 
    187                      END DO 
     218      t_dta(:,:,:) = sf_tem(1)%fnow(:,:,:)  
     219#endif 
     220          
     221      IF( ln_sco ) THEN 
     222         DO jj = 1, jpj                  ! interpolation of temperatures 
     223            DO ji = 1, jpi 
     224               DO jk = 1, jpk 
     225                  zl=fsdept_0(ji,jj,jk) 
     226                  IF(zl < gdept_0(1))   ztemdta(jk) =  t_dta(ji,jj,1) 
     227                  IF(zl > gdept_0(jpk)) ztemdta(jk) =  t_dta(ji,jj,jpkm1)  
     228                  DO jkk = 1, jpkm1 
     229                     IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 
     230                        ztemdta(jk) = t_dta(ji,jj,jkk)                                 & 
     231                                  &    + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))  & 
     232                                  &    * (t_dta(ji,jj,jkk+1) - t_dta(ji,jj,jkk)) 
     233                     ENDIF 
    188234                  END DO 
    189235               END DO 
    190                !                                         ! New temperature profile at Bab el Mandeb 
    191                il0 = 164   ;   il1 = 164 
    192                ij0 =  87   ;   ij1 =  88 
    193                ii0 = 161   ;   ii1 = 163 
    194                DO jl = mi0(il0), mi1(il1) 
    195                   DO jj = mj0(ij0), mj1(ij1) 
    196                      DO ji = mi0(ii0), mi1(ii1) 
    197 #if defined key_orca_lev10 
    198                         ztem  (ji,jj,:,:) = ztem  (jl,jj,:,:) 
    199 #else 
    200                         temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 
    201 #endif 
    202                      END DO 
    203                   END DO 
    204                END DO 
    205                ! 
    206             ELSE 
    207                !                                         ! Reduced temperature at Red Sea 
    208                ij0 =  87   ;   ij1 =  96 
    209                ii0 = 148   ;   ii1 = 160 
    210 #if defined key_orca_lev10 
    211                ztem  ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0  
    212                ztem  ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5  
    213                ztem  ( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 
    214 #else 
    215                temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0  
    216                temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5  
    217                temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 
    218 #endif 
    219             ENDIF 
    220             ! 
    221          ENDIF 
    222 #endif 
    223           
    224 #if defined key_orca_lev10 
    225          ! interpolate from 31 to 301 level the ztem field result in temdta 
    226          DO jl = 1, 2 
    227             DO jjk = 1, 5 
    228                temdta(:,:,jjk,jl) = ztem(:,:,1,jl) 
    229             END DO 
    230             DO jk = 1, jpk-20,10 
    231                ik = jk+5 
    232                ikr =  INT(jk/10) + 1 
    233                ikw =  (ikr-1) *10 + 1 
    234                ikt =  ikw + 5 
    235                DO jjk=ikt,ikt+9 
    236                   zfac = ( gdept_0(jjk   ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 
    237                   temdta(:,:,jjk,jl) = ztem(:,:,ikr,jl) + ( ztem(:,:,ikr+1,jl) - ztem(:,:,ikr,jl) ) * zfac 
    238                END DO 
    239             END DO 
    240             DO jjk = jpk-5, jpk 
    241                temdta(:,:,jjk,jl) = ztem(:,:,jpkdta-1,jl) 
    242             END DO 
    243             ! fill the overlap areas 
    244             CALL lbc_lnk (temdta(:,:,:,jl),'Z',-999.,'no0') 
    245          END DO 
    246 #endif 
    247           
    248          IF( ln_sco ) THEN 
    249             DO jl = 1, 2 
    250                DO jj = 1, jpj                  ! interpolation of temperatures 
    251                   DO ji = 1, jpi 
    252                      DO jk = 1, jpk 
    253                         zl=fsdept_0(ji,jj,jk) 
    254                         IF(zl < gdept_0(1)) ztemdta(jk,jl) =  temdta(ji,jj,1,jl) 
    255                         IF(zl > gdept_0(jpk)) ztemdta(jk,jl) =  temdta(ji,jj,jpkm1,jl) 
    256                         DO jkk = 1, jpkm1 
    257                            IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 
    258                               ztemdta(jk,jl) = temdta(ji,jj,jkk,jl)                                 & 
    259                                    &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))      & 
    260                                    &                              *(temdta(ji,jj,jkk+1,jl) - temdta(ji,jj,jkk,jl)) 
    261                            ENDIF 
    262                         END DO 
    263                      END DO 
    264                      DO jk = 1, jpkm1 
    265                         temdta(ji,jj,jk,jl) = ztemdta(jk,jl) 
    266                      END DO 
    267                      temdta(ji,jj,jpk,jl) = 0.0 
    268                   END DO 
    269                END DO 
    270             END DO 
    271              
    272             IF(lwp) WRITE(numout,*) 
    273             IF(lwp) WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate' 
    274             IF(lwp) WRITE(numout,*) 
    275              
    276          ELSE 
    277              
    278             !                                  ! Mask 
    279             DO jl = 1, 2 
    280                temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:) 
    281                temdta(:,:,jpk,jl) = 0. 
    282                IF( ln_zps ) THEN                ! z-coord. with partial steps 
    283                   DO jj = 1, jpj                  ! interpolation of temperature at the last level 
    284                      DO ji = 1, jpi 
    285                         ik = mbathy(ji,jj) - 1 
    286                         IF( ik > 2 ) THEN 
    287                            zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 
    288                            temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 
    289                         ENDIF 
    290                      END DO 
    291                   END DO 
    292                ENDIF 
    293             END DO 
    294              
    295          ENDIF 
    296           
    297          IF(lwp) THEN 
    298             WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2 
     236               DO jk = 1, jpkm1 
     237                  t_dta(ji,jj,jk) = ztemdta(jk) 
     238               END DO 
     239               t_dta(ji,jj,jpk) = 0.0 
     240            END DO 
     241         END DO 
     242             
     243         IF( lwp .AND. kt==nn_it000 )THEN 
    299244            WRITE(numout,*) 
    300             WRITE(numout,*) ' Levitus month = ', ntem1, '  level = 1' 
    301             CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    302             WRITE(numout,*) ' Levitus month = ', ntem1, '  level = ', jpk/2 
    303             CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    304             WRITE(numout,*) ' Levitus month = ',ntem1,'  level = ', jpkm1 
    305             CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    306          ENDIF 
    307       ENDIF 
    308        
    309        
    310       ! 2. At every time step compute temperature data 
    311       ! ---------------------------------------------- 
    312        
    313       zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 
    314       t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2) 
    315        
    316       ! Close the file 
    317       ! -------------- 
    318        
    319       IF( kt == nitend )   CALL iom_close (numtdt) 
    320        
    321     END SUBROUTINE dta_tem 
     245            WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate' 
     246            WRITE(numout,*) 
     247         ENDIF 
     248             
     249      ELSE 
     250         !                                  ! Mask 
     251         t_dta(:,:,:  ) = t_dta(:,:,:) * tmask(:,:,:) 
     252         t_dta(:,:,jpk) = 0. 
     253         IF( ln_zps ) THEN                ! z-coord. with partial steps 
     254            DO jj = 1, jpj                ! interpolation of temperature at the last level 
     255               DO ji = 1, jpi 
     256                  ik = mbathy(ji,jj) - 1 
     257                  IF( ik > 2 ) THEN 
     258                     zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 
     259                     t_dta(ji,jj,ik) = (1.-zl) * t_dta(ji,jj,ik) + zl * t_dta(ji,jj,ik-1) 
     260                  ENDIF 
     261            END DO 
     262         END DO 
     263      ENDIF 
     264 
     265   ENDIF 
     266          
     267   IF( lwp .AND. kt==nn_it000 ) THEN 
     268      WRITE(numout,*) ' temperature Levitus ' 
     269      WRITE(numout,*) 
     270      WRITE(numout,*)'  level = 1' 
     271      CALL prihre( t_dta(:,:,1    ), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     272      WRITE(numout,*)'  level = ', jpk/2 
     273      CALL prihre( t_dta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     274      WRITE(numout,*)'  level = ', jpkm1 
     275      CALL prihre( t_dta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     276   ENDIF 
     277 
     278   END SUBROUTINE dta_tem 
    322279 
    323280#else 
  • branches/devmercator2010/NEMO/OPA_SRC/SBC/fldread.F90

    r2076 r2077  
    4848      INTEGER , DIMENSION(2)          ::   nrec_b       ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year) 
    4949      INTEGER , DIMENSION(2)          ::   nrec_a       ! after  record (1: index, 2: second since Jan. 1st 00h of nit000 year) 
    50       REAL(wp) , ALLOCATABLE, DIMENSION(:,:)   ::   fnow         ! input fields interpolated to now time step 
    51       REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:) ::   fdta         ! 2 consecutive record of input fields 
     50      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:)   ::   fnow       ! input fields interpolated to now time step 
     51      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta       ! 2 consecutive record of input fields 
    5252      CHARACTER(len = 256)            ::   wgtname      ! current name of the NetCDF weight file acting as a key 
    5353                                                        ! into the WGTLIST structure 
     
    7878      INTEGER, DIMENSION(:,:,:), POINTER      ::   data_jpj     ! array of source integers 
    7979      REAL(wp), DIMENSION(:,:,:), POINTER     ::   data_wgt     ! array of weights on model grid 
    80       REAL(wp), DIMENSION(:,:), POINTER       ::   fly_dta      ! array of values on input grid 
    81       REAL(wp), DIMENSION(:,:), POINTER       ::   col2         ! temporary array for reading in columns 
     80      REAL(wp), DIMENSION(:,:,:), POINTER     ::   fly_dta      ! array of values on input grid 
     81      REAL(wp), DIMENSION(:,:,:), POINTER     ::   col2         ! temporary array for reading in columns 
    8282   END TYPE WGT 
    8383 
     
    120120 
    121121      INTEGER  ::   jf         ! dummy indices 
     122      INTEGER  ::   jk         ! dummy indices 
     123      INTEGER  ::   ipk        ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    122124      INTEGER  ::   kw         ! index into wgts array 
    123125      INTEGER  ::   ireclast   ! last record to be read in the current year file 
     
    143145            IF( sd(jf)%ln_tint ) THEN         ! time interpolation: swap before record field 
    144146!CDIR COLLAPSE 
    145                sd(jf)%fdta(:,:,1) = sd(jf)%fdta(:,:,2) 
    146                sd(jf)%rotn(1)     = sd(jf)%rotn(2) 
     147               sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) 
     148               sd(jf)%rotn(1)       = sd(jf)%rotn(2) 
    147149            ENDIF 
    148150 
     
    157159 
    158160               ! last record to be read in the current file 
    159                IF( sd(jf)%nfreqh == -1 ) THEN                  ;   ireclast = 12 
     161               IF( sd(jf)%nfreqh == -1 ) THEN 
     162                  IF(     sd(jf)%cltype == 'monthly'   ) THEN  ;   ireclast = 1 
     163                  ELSE                                         ;   ireclast = 12 
     164                  ENDIF 
    160165               ELSE                              
    161166                  IF(     sd(jf)%cltype == 'monthly'   ) THEN  ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh  
     
    204209            IF( LEN(TRIM(sd(jf)%wgtname)) > 0 ) THEN 
    205210               CALL wgt_list( sd(jf), kw ) 
    206                CALL fld_interp( sd(jf)%num, sd(jf)%clvar, kw, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) ) 
     211               ipk =  SIZE(sd(jf)%fdta,3) 
     212               CALL fld_interp( sd(jf)%num, sd(jf)%clvar , kw , ipk, sd(jf)%fdta(:,:,:,2) , sd(jf)%nrec_a(1) ) 
    207213            ELSE 
    208                CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) ) 
     214               SELECT CASE( SIZE(sd(jf)%fdta,3) ) 
     215               CASE(1) 
     216                  CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,1,2), sd(jf)%nrec_a(1) ) 
     217               CASE(jpk) 
     218                  CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,:,2), sd(jf)%nrec_a(1) ) 
     219               END SELECT 
    209220            ENDIF 
    210221            sd(jf)%rotn(2) = .FALSE. 
     
    245256                         utmp(:,:) = 0.0 
    246257                         vtmp(:,:) = 0.0 
    247                          CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->i', utmp(:,:) ) 
    248                          CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->j', vtmp(:,:) ) 
    249                          sd(jf)%fdta(:,:,nf) = utmp(:,:) 
    250                          sd(kf)%fdta(:,:,nf) = vtmp(:,:) 
     258                         ! 
     259                         ipk = SIZE( sd(kf)%fdta(:,:,:,nf) ,3 ) 
     260                         DO jk = 1,ipk 
     261                            CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->i', utmp(:,:) ) 
     262                            CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->j', vtmp(:,:) ) 
     263                            sd(jf)%fdta(:,:,jk,nf) = utmp(:,:) 
     264                            sd(kf)%fdta(:,:,jk,nf) = vtmp(:,:) 
     265                         END DO 
     266                         ! 
    251267                         sd(jf)%rotn(nf) = .TRUE. 
    252268                         sd(kf)%rotn(nf) = .TRUE. 
     
    280296               ztintb =  1. - ztinta 
    281297!CDIR COLLAPSE 
    282                sd(jf)%fnow(:,:) = ztintb * sd(jf)%fdta(:,:,1) + ztinta * sd(jf)%fdta(:,:,2) 
     298               sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2) 
    283299            ELSE 
    284300               IF(lwp .AND. kt - nit000 <= 100 ) THEN 
     
    288304               ENDIF 
    289305!CDIR COLLAPSE 
    290                sd(jf)%fnow(:,:) = sd(jf)%fdta(:,:,2)   ! piecewise constant field 
     306               sd(jf)%fnow(:,:,:) = sd(jf)%fdta(:,:,:,2)   ! piecewise constant field 
    291307  
    292308            ENDIF 
     
    320336      INTEGER :: inrec          ! number of record existing for this variable 
    321337      INTEGER :: kwgt 
     338      INTEGER :: jk             !vertical loop variable 
     339      INTEGER :: ipk            !number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    322340      CHARACTER(LEN=1000) ::   clfmt   ! write format 
    323341      !!--------------------------------------------------------------------- 
     
    339357               IF( sdjf%cltype == 'monthly' ) THEN   ! monthly file 
    340358                  sdjf%nrec_b(1) = 1                                                       ! force to read the unique record 
    341                   llprevmth = .NOT. sdjf%ln_clim                                           ! use previous month file? 
     359                  llprevmth = .TRUE.                                                       ! use previous month file? 
    342360                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file? 
    343361               ELSE                                  ! yearly file 
     
    366384            &                  nmonth - COUNT((/llprevmth/)) + 12                   * COUNT((/llprevyr /)),               & 
    367385            &                  nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)), .NOT. llprev ) 
    368           
     386 
    369387         ! if previous year/month/day file does not exist, we switch to the current year/month/day 
    370388         IF( llprev .AND. sdjf%num == 0 ) THEN 
     
    384402 
    385403         ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read 
     404          
    386405         IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
    387406            CALL wgt_list( sdjf, kwgt ) 
    388             CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, sdjf%fdta(:,:,2), sdjf%nrec_b(1) ) 
     407            ipk = SIZE(sdjf%fdta,3) 
     408            CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, ipk, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 
    389409         ELSE 
    390             CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,2), sdjf%nrec_b(1) ) 
     410            SELECT CASE ( SIZE(sdjf%fdta,3) ) 
     411            CASE(1) 
     412                CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_b(1) ) 
     413            CASE(jpk) 
     414                CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_b(1) ) 
     415            END SELECT 
    391416         ENDIF 
    392417         sdjf%rotn(2) = .FALSE. 
     
    399424      ENDIF 
    400425 
     426 
    401427      IF( sdjf%num == 0 )   CALL fld_clopn( sdjf, nyear, nmonth, nday )   ! make sure current year/month/day file is opened 
    402428 
    403429      sdjf%nswap_sec = nsec_year + nsec1jan000 - 1   ! force read/update the after data in the following part of fld_read  
    404        
     430      
    405431   END SUBROUTINE fld_init 
    406432 
     
    436462            !       forcing record :  nmonth  
    437463            !                             
    438             ztmp  = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 
     464            ztmp  = 0.e0 
     465            IF(  REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) .GT. 0.5 ) ztmp  = 1.0 
    439466         ELSE 
    440467            ztmp  = 0.e0 
     
    446473         ENDIF 
    447474 
    448          sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define after  record number and time 
    449          irec = irec - 1                                                ! move back to previous record 
    450          sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define before record number and time 
     475         IF( sdjf%cltype == 'monthly' ) THEN 
     476 
     477            sdjf%nrec_b(:) = (/ 0, nmonth_half(irec - 1 ) + nsec1jan000 /) 
     478            sdjf%nrec_a(:) = (/ 1, nmonth_half(irec     ) + nsec1jan000 /) 
     479 
     480            IF( ztmp  == 1. ) THEN 
     481              sdjf%nrec_b(1) = 1 
     482              sdjf%nrec_a(1) = 2 
     483            ENDIF 
     484 
     485         ELSE 
     486 
     487            sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define after  record number and time 
     488            irec = irec - 1                                                ! move back to previous record 
     489            sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define before record number and time 
     490 
     491         ENDIF 
    451492         ! 
    452493      ELSE                              ! higher frequency mean (in hours) 
     
    534575         IF( sdjf%cltype /= 'yearly' )    WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname     ), kmonth   ! add month 
    535576         IF( sdjf%cltype == 'daily'  )    WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname     ), kday     ! add day 
     577      ELSE 
     578         ! build the new filename if climatological data 
     579         IF( sdjf%cltype == 'monthly' )   WRITE(sdjf%clname, '(a,"_m" ,i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month 
    536580      ENDIF 
    537581      CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 ) 
     
    564608         sdf(jf)%ln_tint    = sdf_n(jf)%ln_tint 
    565609         sdf(jf)%ln_clim    = sdf_n(jf)%ln_clim 
    566          IF( sdf(jf)%nfreqh == -1. ) THEN   ;   sdf(jf)%cltype = 'yearly' 
    567          ELSE                               ;   sdf(jf)%cltype = sdf_n(jf)%cltype 
    568          ENDIF 
     610         sdf(jf)%cltype     = sdf_n(jf)%cltype 
    569611         sdf(jf)%wgtname = " " 
    570612         IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 )   sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname ) 
     
    684726      INTEGER                                 ::   inum          ! temporary logical unit 
    685727      INTEGER                                 ::   id            ! temporary variable id 
     728      INTEGER                                 ::   ipk           ! temporary vertical dimension 
    686729      CHARACTER (len=5)                       ::   aname 
    687730      INTEGER , DIMENSION(3)                  ::   ddims 
     
    848891         ! SA: +3 stencil is a patch to avoid out-of-bound computation in some configuration.  
    849892         ! a more robust solution will be given in next release 
    850          ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3) ) 
    851          IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col2(2,ref_wgts(nxt_wgt)%jpjwgt+3) ) 
     893         ipk =  SIZE(sd%fdta,3) 
     894         ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3 ,ipk) ) 
     895         IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col2(2,ref_wgts(nxt_wgt)%jpjwgt+3,ipk) ) 
    852896 
    853897         nxt_wgt = nxt_wgt + 1 
     
    859903   END SUBROUTINE fld_weight 
    860904 
    861    SUBROUTINE fld_interp(num, clvar, kw, dta, nrec) 
     905   SUBROUTINE fld_interp(num, clvar, kw, kk, dta, nrec) 
    862906      !!--------------------------------------------------------------------- 
    863907      !!                    ***  ROUTINE fld_interp  *** 
     
    868912      !! ** Method  :    
    869913      !!---------------------------------------------------------------------- 
    870       INTEGER,          INTENT(in)                        ::   num                 ! stream number 
    871       CHARACTER(LEN=*), INTENT(in)                        ::   clvar               ! variable name 
    872       INTEGER,          INTENT(in)                        ::   kw                  ! weights number 
    873       REAL(wp),         INTENT(inout), DIMENSION(jpi,jpj) ::   dta                 ! output field on model grid 
    874       INTEGER,          INTENT(in)                        ::   nrec                ! record number to read (ie time slice) 
     914      INTEGER,          INTENT(in)                           ::   num                 ! stream number 
     915      CHARACTER(LEN=*), INTENT(in)                           ::   clvar               ! variable name 
     916      INTEGER,          INTENT(in)                           ::   kw                  ! weights number 
     917      INTEGER,          INTENT(in)                           ::   kk                  ! vertical dimension of kk 
     918      REAL(wp),         INTENT(inout), DIMENSION(jpi,jpj,kk) ::   dta                 ! output field on model grid 
     919      INTEGER,          INTENT(in)                           ::   nrec                ! record number to read (ie time slice) 
    875920      !!  
    876       INTEGER, DIMENSION(2)                               ::   rec1,recn           ! temporary arrays for start and length 
    877       INTEGER                                             ::  jk, jn, jm           ! loop counters 
    878       INTEGER                                             ::  ni, nj               ! lengths 
    879       INTEGER                                             ::  jpimin,jpiwid        ! temporary indices 
    880       INTEGER                                             ::  jpjmin,jpjwid        ! temporary indices 
    881       INTEGER                                             ::  jpi1,jpi2,jpj1,jpj2  ! temporary indices 
     921      INTEGER, DIMENSION(3)                                  ::   rec1,recn           ! temporary arrays for start and length 
     922      INTEGER                                                ::  jk, jn, jm           ! loop counters 
     923      INTEGER                                                ::  ni, nj               ! lengths 
     924      INTEGER                                                ::  jpimin,jpiwid        ! temporary indices 
     925      INTEGER                                                ::  jpjmin,jpjwid        ! temporary indices 
     926      INTEGER                                                ::  jpi1,jpi2,jpj1,jpj2  ! temporary indices 
    882927      !!---------------------------------------------------------------------- 
    883928      ! 
     
    897942      rec1(1) = MAX( jpimin-1, 1 ) 
    898943      rec1(2) = MAX( jpjmin-1, 1 ) 
     944      rec1(3) = 1 
    899945      recn(1) = MIN( jpiwid+2, ref_wgts(kw)%ddims(1)-rec1(1)+1 ) 
    900946      recn(2) = MIN( jpjwid+2, ref_wgts(kw)%ddims(2)-rec1(2)+1 ) 
     947      recn(3) = kk 
    901948 
    902949      !! where we need to read it to 
     
    906953      jpj2 = jpj1 + recn(2) - 1 
    907954 
    908       ref_wgts(kw)%fly_dta(:,:) = 0.0 
    909       CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2), nrec, rec1, recn) 
     955      ref_wgts(kw)%fly_dta(:,:,:) = 0.0 
     956      SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) ) 
     957      CASE(1) 
     958           CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn) 
     959      CASE(jpk)   
     960           CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn) 
     961      END SELECT  
    910962 
    911963      !! first four weights common to both bilinear and bicubic 
    912964      !! note that we have to offset by 1 into fly_dta array because of halo 
    913       dta(:,:) = 0.0 
     965      dta(:,:,:) = 0.0 
    914966      DO jk = 1,4 
    915         DO jn = 1, jpj 
    916           DO jm = 1,jpi 
     967        DO jn = 1, nlcj 
     968          DO jm = 1,nlci 
    917969            ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    918970            nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    919             dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1) 
     971            dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1,jk) 
    920972          END DO 
    921973        END DO 
     
    926978        !! fix up halo points that we couldnt read from file 
    927979        IF( jpi1 == 2 ) THEN 
    928            ref_wgts(kw)%fly_dta(jpi1-1,:) = ref_wgts(kw)%fly_dta(jpi1,:) 
     980           ref_wgts(kw)%fly_dta(jpi1-1,:,:) = ref_wgts(kw)%fly_dta(jpi1,:,:) 
    929981        ENDIF 
    930982        IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 
    931            ref_wgts(kw)%fly_dta(jpi2+1,:) = ref_wgts(kw)%fly_dta(jpi2,:) 
     983           ref_wgts(kw)%fly_dta(jpi2+1,:,:) = ref_wgts(kw)%fly_dta(jpi2,:,:) 
    932984        ENDIF 
    933985        IF( jpj1 == 2 ) THEN 
    934            ref_wgts(kw)%fly_dta(:,jpj1-1) = ref_wgts(kw)%fly_dta(:,jpj1) 
     986           ref_wgts(kw)%fly_dta(:,jpj1-1,:) = ref_wgts(kw)%fly_dta(:,jpj1,:) 
    935987        ENDIF 
    936988        IF( jpj2 + jpjmin - 1 == ref_wgts(kw)%ddims(2)+1 .AND. jpj2 .lt. jpjwid+2 ) THEN 
    937            ref_wgts(kw)%fly_dta(:,jpj2+1) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2) - ref_wgts(kw)%fly_dta(:,jpj2-1) 
     989           ref_wgts(kw)%fly_dta(:,jpj2+1,:) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2,:) - ref_wgts(kw)%fly_dta(:,jpj2-1,:) 
    938990        ENDIF 
    939991 
     
    9481000           IF( jpi1 == 2 ) THEN 
    9491001              rec1(1) = ref_wgts(kw)%ddims(1) - 1 
    950               CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn) 
    951               ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2) = ref_wgts(kw)%col2(ref_wgts(kw)%offset+1,jpj1:jpj2) 
     1002              SELECT CASE( SIZE( ref_wgts(kw)%col2(:,jpj1:jpj2,:),3) ) 
     1003              CASE(1) 
     1004                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,1), nrec, rec1, recn) 
     1005              CASE(jpk)          
     1006                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,:), nrec, rec1, recn) 
     1007              END SELECT       
     1008              ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col2(ref_wgts(kw)%offset+1,jpj1:jpj2,:) 
    9521009           ENDIF 
    9531010           IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 
    9541011              rec1(1) = 1 
    955               CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn) 
    956               ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2) = ref_wgts(kw)%col2(2-ref_wgts(kw)%offset,jpj1:jpj2) 
     1012              SELECT CASE( SIZE( ref_wgts(kw)%col2(:,jpj1:jpj2,:),3) ) 
     1013              CASE(1) 
     1014                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,1), nrec, rec1, recn) 
     1015              CASE(jpk) 
     1016                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,:), nrec, rec1, recn) 
     1017              END SELECT 
     1018              ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col2(2-ref_wgts(kw)%offset,jpj1:jpj2,:) 
    9571019           ENDIF 
    9581020        ENDIF 
     
    9601022        ! gradient in the i direction 
    9611023        DO jk = 1,4 
    962           DO jn = 1, jpj 
    963             DO jm = 1,jpi 
     1024          DO jn = 1, nlcj 
     1025            DO jm = 1,nlci 
    9641026              ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    9651027              nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    966               dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 *         & 
    967                                (ref_wgts(kw)%fly_dta(ni+2,nj+1) - ref_wgts(kw)%fly_dta(ni,nj+1)) 
     1028              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 *         & 
     1029                               (ref_wgts(kw)%fly_dta(ni+2,nj+1,:) - ref_wgts(kw)%fly_dta(ni,nj+1,:)) 
    9681030            END DO 
    9691031          END DO 
     
    9721034        ! gradient in the j direction 
    9731035        DO jk = 1,4 
    974           DO jn = 1, jpj 
    975             DO jm = 1,jpi 
     1036          DO jn = 1, nlcj 
     1037            DO jm = 1,nlci 
    9761038              ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    9771039              nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    978               dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 *         & 
    979                                (ref_wgts(kw)%fly_dta(ni+1,nj+2) - ref_wgts(kw)%fly_dta(ni+1,nj)) 
     1040              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 *         & 
     1041                               (ref_wgts(kw)%fly_dta(ni+1,nj+2,:) - ref_wgts(kw)%fly_dta(ni+1,nj,:)) 
    9801042            END DO 
    9811043          END DO 
     
    9881050              ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    9891051              nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    990               dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( & 
    991                                (ref_wgts(kw)%fly_dta(ni+2,nj+2) - ref_wgts(kw)%fly_dta(ni  ,nj+2)) -   & 
    992                                (ref_wgts(kw)%fly_dta(ni+2,nj  ) - ref_wgts(kw)%fly_dta(ni  ,nj  ))) 
     1052              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( & 
     1053                               (ref_wgts(kw)%fly_dta(ni+2,nj+2,:) - ref_wgts(kw)%fly_dta(ni  ,nj+2,:)) -   & 
     1054                               (ref_wgts(kw)%fly_dta(ni+2,nj  ,:) - ref_wgts(kw)%fly_dta(ni  ,nj  ,:))) 
    9931055            END DO 
    9941056          END DO 
  • branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r2075 r2077  
    162162 
    163163         DO ifpr= 1, jpfld 
    164             ALLOCATE( sf(ifpr)%fnow(jpi,jpj) ) 
    165             ALLOCATE( sf(ifpr)%fdta(jpi,jpj,2) ) 
     164            ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 
     165            ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
    166166         END DO 
    167167 
     
    178178      ! 
    179179#if defined key_lim3       
    180       tatm_ice(:,:) = sf(jp_tair)%fnow(:,:)     !RB ugly patch 
     180      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)     !RB ugly patch 
    181181#endif 
    182182      ! 
     
    272272      DO jj = 1 , jpj 
    273273         DO ji = 1, jpi 
    274             utau(ji,jj) = sf(jp_utau)%fnow(ji,jj) 
    275             vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj) 
     274            utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
     275            vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
    276276         END DO 
    277277      END DO 
     
    297297      DO jj = 1 , jpj 
    298298         DO ji = 1, jpi 
    299             wndm(ji,jj) = sf(jp_wndm)%fnow(ji,jj) 
     299            wndm(ji,jj) = sf(jp_wndm)%fnow(ji,jj,1) 
    300300         END DO 
    301301      END DO 
     
    317317            ! 
    318318            zsst  = pst(ji,jj)              + rt0           ! converte Celcius to Kelvin the SST 
    319             ztatm = sf(jp_tair)%fnow(ji,jj               ! and set minimum value far above 0 K (=rt0 over land) 
    320             zcco1 = 1.0 - sf(jp_ccov)%fnow(ji,jj         ! fraction of clear sky ( 1 - cloud cover) 
     319            ztatm = sf(jp_tair)%fnow(ji,jj,1)               ! and set minimum value far above 0 K (=rt0 over land) 
     320            zcco1 = 1.0 - sf(jp_ccov)%fnow(ji,jj,1)         ! fraction of clear sky ( 1 - cloud cover) 
    321321            zrhoa = zpatm / ( 287.04 * ztatm )              ! air density (equation of state for dry air)  
    322322            ztamr = ztatm - rtt                             ! Saturation water vapour 
     
    325325            zmt3  = SIGN( 28.200, -ztamr )                  !           \/ 
    326326            zes   = 611.0 * EXP(  ABS( ztamr ) * MIN ( zmt1, zmt2 ) / ( ztatm - 35.86  + MAX( 0.e0, zmt3 ) )  ) 
    327             zev    = sf(jp_humi)%fnow(ji,jj) * zes          ! vapour pressure   
     327            zev    = sf(jp_humi)%fnow(ji,jj,1) * zes        ! vapour pressure   
    328328            zevsqr = SQRT( zev * 0.01 )                     ! square-root of vapour pressure 
    329329            zqatm = 0.622 * zev / ( zpatm - 0.378 * zev )   ! specific humidity  
     
    333333            !--------------------------------------! 
    334334            ztatm3  = ztatm * ztatm * ztatm 
    335             zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj) * sf(jp_ccov)%fnow(ji,jj)     
     335            zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj,1) * sf(jp_ccov)%fnow(ji,jj,1)     
    336336            ztaevbk = ztatm * ztatm3 * zcldeff * ( 0.39 - 0.05 * zevsqr )  
    337337            ! 
     
    351351            zdeltaq = zqatm - zqsato 
    352352            ztvmoy  = ztatm * ( 1. + 2.2e-3 * ztatm * zqatm ) 
    353             zdenum  = MAX( sf(jp_wndm)%fnow(ji,jj) * sf(jp_wndm)%fnow(ji,jj) * ztvmoy, zeps ) 
     353            zdenum  = MAX( sf(jp_wndm)%fnow(ji,jj,1) * sf(jp_wndm)%fnow(ji,jj,1) * ztvmoy, zeps ) 
    354354            zdtetar = zdteta / zdenum 
    355355            ztvmoyr = ztvmoy * ztvmoy * zdeltaq / zdenum 
     
    373373            zpsil   = zpsih 
    374374             
    375             zvatmg         = MAX( 0.032 * 1.5e-3 * sf(jp_wndm)%fnow(ji,jj) * sf(jp_wndm)%fnow(ji,jj) / grav, zeps ) 
     375            zvatmg         = MAX( 0.032 * 1.5e-3 * sf(jp_wndm)%fnow(ji,jj,1) * sf(jp_wndm)%fnow(ji,jj,1) / grav, zeps ) 
    376376            zcmn           = vkarmn / LOG ( 10. / zvatmg ) 
    377377            zchn           = 0.0327 * zcmn 
     
    387387            zcleo          = zcln * zclcm  
    388388 
    389             zrhova         = zrhoa * sf(jp_wndm)%fnow(ji,jj) 
     389            zrhova         = zrhoa * sf(jp_wndm)%fnow(ji,jj,1) 
    390390 
    391391            ! sensible heat flux 
     
    408408         DO ji = 1, jpi 
    409409            qns (ji,jj) = zqlw(ji,jj) - zqsb(ji,jj) - zqla(ji,jj)      ! Downward Non Solar flux 
    410             emp (ji,jj) = zqla(ji,jj) / cevap - sf(jp_prec)%fnow(ji,jj) / rday * tmask(ji,jj,1) 
     410            emp (ji,jj) = zqla(ji,jj) / cevap - sf(jp_prec)%fnow(ji,jj,1) / rday * tmask(ji,jj,1) 
    411411         END DO 
    412412      END DO 
     
    530530!CDIR NOVERRCHK 
    531531         DO ji = 1, jpi 
    532             ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj                ! air temperature in Kelvins  
     532            ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj,1)                ! air temperature in Kelvins  
    533533       
    534534            zrhoa(ji,jj) = zpatm / ( 287.04 * ztatm(ji,jj) )         ! air density (equation of state for dry air)  
     
    541541               &                / ( ztatm(ji,jj) - 35.86  + MAX( 0.e0, zmt3 ) )  ) 
    542542 
    543             zev = sf(jp_humi)%fnow(ji,jj) * zes                      ! vapour pressure   
     543            zev = sf(jp_humi)%fnow(ji,jj,1) * zes                      ! vapour pressure   
    544544            zevsqr(ji,jj) = SQRT( zev * 0.01 )                       ! square-root of vapour pressure 
    545545            zqatm(ji,jj) = 0.622 * zev / ( zpatm - 0.378 * zev )     ! specific humidity  
     
    551551            zmt2  = ( 272.0 - ztatm(ji,jj) ) / 38.0   ;   zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) ) 
    552552            zmt3  = ( 281.0 - ztatm(ji,jj) ) / 18.0   ;   zind3 = MAX( 0.e0, SIGN( 1.e0, zmt3 ) ) 
    553             p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj) / rday   &        ! rday = converte mm/day to kg/m2/s 
     553            p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday   &      ! rday = converte mm/day to kg/m2/s 
    554554               &         * (          zind1      &                   ! solid  (snow) precipitation [kg/m2/s] 
    555555               &            + ( 1.0 - zind1 ) * (          zind2   * ( 0.5 + zmt2 )   & 
     
    561561            ! fraction of qsr_ice which is NOT absorbed in the thin surface layer 
    562562            ! and thus which penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 
    563             p_fr1(ji,jj) = 0.18  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj)  
    564             p_fr2(ji,jj) = 0.82  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj) 
     563            p_fr1(ji,jj) = 0.18  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1)  
     564            p_fr2(ji,jj) = 0.82  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1) 
    565565         END DO 
    566566      END DO 
     
    584584               !-------------------------------------------! 
    585585               ztatm3  = ztatm(ji,jj) * ztatm(ji,jj) * ztatm(ji,jj) 
    586                zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj) * sf(jp_ccov)%fnow(ji,jj)     
     586               zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj,1) * sf(jp_ccov)%fnow(ji,jj,1)     
    587587               ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) )  
    588588               ! 
     
    609609                
    610610               !  sensible and latent fluxes over ice 
    611                zrhova     = zrhoa(ji,jj) * sf(jp_wndm)%fnow(ji,jj)      ! computation of intermediate values 
     611               zrhova     = zrhoa(ji,jj) * sf(jp_wndm)%fnow(ji,jj,1)      ! computation of intermediate values 
    612612               zrhovaclei = zrhova * zcshi * 2.834e+06 
    613613               zrhovacshi = zrhova * zclei * 1004.0 
     
    639639      p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:)      ! Downward Non Solar flux 
    640640!CDIR COLLAPSE 
    641       p_tpr(:,:)   = sf(jp_prec)%fnow(:,:) / rday                       ! total precipitation [kg/m2/s] 
     641      p_tpr(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                       ! total precipitation [kg/m2/s] 
    642642      ! 
    643643!!gm : not necessary as all input data are lbc_lnk... 
     
    735735!CDIR NOVERRCHK 
    736736         DO ji = 1, jpi 
    737             ztamr = sf(jp_tair)%fnow(ji,jj) - rtt 
     737            ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt 
    738738            zmt1  = SIGN( 17.269,  ztamr ) 
    739739            zmt2  = SIGN( 21.875,  ztamr ) 
    740740            zmt3  = SIGN( 28.200, -ztamr ) 
    741741            zes = 611.0 * EXP(  ABS( ztamr ) * MIN ( zmt1, zmt2 )   &              ! Saturation water vapour 
    742                &                     / ( sf(jp_tair)%fnow(ji,jj) - 35.86  + MAX( 0.e0, zmt3 ) )  ) 
    743             zev(ji,jj) = sf(jp_humi)%fnow(ji,jj) * zes * 1.0e-05                   ! vapour pressure   
     742               &                     / ( sf(jp_tair)%fnow(ji,jj,1) - 35.86  + MAX( 0.e0, zmt3 ) )  ) 
     743            zev(ji,jj) = sf(jp_humi)%fnow(ji,jj,1) * zes * 1.0e-05                   ! vapour pressure   
    744744         END DO 
    745745      END DO 
     
    798798 
    799799               ! ocean albedo depending on the cloud cover (Payne, 1972) 
    800                za_oce     = ( 1.0 - sf(jp_ccov)%fnow(ji,jj) ) * 0.05 / ( 1.1 * zcmue**1.4 + 0.15 )   &   ! clear sky 
    801                   &       +         sf(jp_ccov)%fnow(ji,jj)   * 0.06                                     ! overcast 
     800               za_oce     = ( 1.0 - sf(jp_ccov)%fnow(ji,jj,1) ) * 0.05 / ( 1.1 * zcmue**1.4 + 0.15 )   &   ! clear sky 
     801                  &       +         sf(jp_ccov)%fnow(ji,jj,1)   * 0.06                                     ! overcast 
    802802 
    803803                  ! solar heat flux absorbed by the ocean (Zillman, 1972) 
     
    814814         DO ji = 1, jpi 
    815815            zlmunoon = ASIN( zps(ji,jj) + zpc(ji,jj) ) / rad                         ! local noon solar altitude 
    816             zcldcor  = MIN(  1.e0, ( 1.e0 - 0.62 * sf(jp_ccov)%fnow(ji,jj)   &       ! cloud correction (Reed 1977) 
     816            zcldcor  = MIN(  1.e0, ( 1.e0 - 0.62 * sf(jp_ccov)%fnow(ji,jj,1)   &       ! cloud correction (Reed 1977) 
    817817               &                          + 0.0019 * zlmunoon )                 ) 
    818818            pqsr_oce(ji,jj) = zcoef1 * zcldcor * pqsr_oce(ji,jj) * tmask(ji,jj,1)   ! and zcoef1: ellipsity 
     
    865865!CDIR NOVERRCHK 
    866866         DO ji = 1, jpi            
    867             ztamr = sf(jp_tair)%fnow(ji,jj) - rtt            
     867            ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt            
    868868            zmt1  = SIGN( 17.269,  ztamr ) 
    869869            zmt2  = SIGN( 21.875,  ztamr ) 
    870870            zmt3  = SIGN( 28.200, -ztamr ) 
    871871            zes = 611.0 * EXP(  ABS( ztamr ) * MIN ( zmt1, zmt2 )   &              ! Saturation water vapour 
    872                &                     / ( sf(jp_tair)%fnow(ji,jj) - 35.86  + MAX( 0.e0, zmt3 ) )  ) 
    873             zev(ji,jj) = sf(jp_humi)%fnow(ji,jj) * zes * 1.0e-05                   ! vapour pressure   
     872               &                     / ( sf(jp_tair)%fnow(ji,jj,1) - 35.86  + MAX( 0.e0, zmt3 ) )  ) 
     873            zev(ji,jj) = sf(jp_humi)%fnow(ji,jj,1) * zes * 1.0e-05                   ! vapour pressure   
    874874         END DO 
    875875      END DO 
     
    938938                     &        / (  1.0 + 0.139  * stauc(ji,jj) * ( 1.0 - 0.9435 * pa_ice_os(ji,jj,jl) ) )        
    939939              
    940                   pqsr_ice(ji,jj,jl) = pqsr_ice(ji,jj,jl) + (  ( 1.0 - sf(jp_ccov)%fnow(ji,jj) ) * zqsr_ice_cs    & 
    941                      &                                       +         sf(jp_ccov)%fnow(ji,jj)   * zqsr_ice_os  ) 
     940                  pqsr_ice(ji,jj,jl) = pqsr_ice(ji,jj,jl) + (  ( 1.0 - sf(jp_ccov)%fnow(ji,jj,1) ) * zqsr_ice_cs    & 
     941                     &                                       +         sf(jp_ccov)%fnow(ji,jj,1)   * zqsr_ice_os  ) 
    942942               END DO 
    943943            END DO 
  • branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r2075 r2077  
    164164         ENDIF 
    165165         DO ifpr= 1, jfld 
    166             ALLOCATE( sf(ifpr)%fnow(jpi,jpj) ) 
    167             ALLOCATE( sf(ifpr)%fdta(jpi,jpj,2) ) 
     166            ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 
     167            ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
    168168         END DO 
    169169         ! 
     
    176176 
    177177#if defined key_lim3 
    178       tatm_ice(:,:) = sf(jp_tair)%fnow(:,:) 
     178      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) 
    179179#endif 
    180180 
     
    244244      DO jj = 2, jpjm1 
    245245         DO ji = fs_2, fs_jpim1   ! vect. opt. 
    246             zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj) - 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  ) 
    247             zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj) - 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  ) 
     246            zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  ) 
     247            zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  ) 
    248248         END DO 
    249249      END DO 
     
    262262      ! ocean albedo assumed to be 0.066 
    263263!CDIR COLLAPSE 
    264       qsr (:,:) = ( 1. - 0.066 ) * sf(jp_qsr)%fnow(:,:) * tmask(:,:,1)                                 ! Short Wave 
    265 !CDIR COLLAPSE 
    266       zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave 
     264      qsr (:,:) = ( 1. - 0.066 ) * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1)                                 ! Short Wave 
     265!CDIR COLLAPSE 
     266      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave 
    267267                       
    268268      ! ----------------------------------------------------------------------------- ! 
     
    307307      IF( lhftau ) THEN  
    308308!CDIR COLLAPSE 
    309          taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:) 
     309         taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 
    310310      ENDIF 
    311311      CALL iom_put( "taum_oce", taum )   ! output wind stress module 
     
    330330      ELSE 
    331331!CDIR COLLAPSE 
    332          zevap(:,:) = MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:) ) * wndm(:,:) )   ! Evaporation 
    333 !CDIR COLLAPSE 
    334          zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:) ) * wndm(:,:)     ! Sensible Heat 
     332         zevap(:,:) = MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) )   ! Evaporation 
     333!CDIR COLLAPSE 
     334         zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:)     ! Sensible Heat 
    335335      ENDIF 
    336336!CDIR COLLAPSE 
     
    355355      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)      ! Downward Non Solar flux 
    356356!CDIR COLLAPSE 
    357       emp (:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:) * rn_pfac * tmask(:,:,1) 
     357      emp (:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) 
    358358!CDIR COLLAPSE 
    359359      emps(:,:) = emp(:,:) 
     
    453453            DO ji = 2, jpim1   ! B grid : no vector opt 
    454454               ! ... scalar wind at I-point (fld being at T-point) 
    455                zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ) + sf(jp_wndi)%fnow(ji  ,jj  )   & 
    456                   &              + sf(jp_wndi)%fnow(ji-1,jj-1) + sf(jp_wndi)%fnow(ji  ,jj-1)  ) - pui(ji,jj) 
    457                zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ) + sf(jp_wndj)%fnow(ji  ,jj  )   & 
    458                   &              + sf(jp_wndj)%fnow(ji-1,jj-1) + sf(jp_wndj)%fnow(ji  ,jj-1)  ) - pvi(ji,jj) 
     455               zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ,1) + sf(jp_wndi)%fnow(ji  ,jj  ,1)   & 
     456                  &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - pui(ji,jj) 
     457               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   & 
     458                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - pvi(ji,jj) 
    459459               zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 
    460460               ! ... ice stress at I-point 
     
    462462               p_tauj(ji,jj) = zwnorm_f * zwndj_f 
    463463               ! ... scalar wind at T-point (fld being at T-point) 
    464                zwndi_t = sf(jp_wndi)%fnow(ji,jj) - 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   & 
     464               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   & 
    465465                  &                                        + pui(ji,jj  ) + pui(ji+1,jj  )  ) 
    466                zwndj_t = sf(jp_wndj)%fnow(ji,jj) - 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   & 
     466               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   & 
    467467                  &                                        + pvi(ji,jj  ) + pvi(ji+1,jj  )  ) 
    468468               z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
     
    479479         DO jj = 2, jpj 
    480480            DO ji = fs_2, jpi   ! vect. opt. 
    481                zwndi_t = (  sf(jp_wndi)%fnow(ji,jj) - 0.5 * ( pui(ji-1,jj  ) + pui(ji,jj) )  ) 
    482                zwndj_t = (  sf(jp_wndj)%fnow(ji,jj) - 0.5 * ( pvi(ji  ,jj-1) + pvi(ji,jj) )  ) 
     481               zwndi_t = (  sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pui(ji-1,jj  ) + pui(ji,jj) )  ) 
     482               zwndj_t = (  sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pvi(ji  ,jj-1) + pvi(ji,jj) )  ) 
    483483               z_wnds_t(ji,jj)  = SQRT( zwndi_t * zwndi_t + zwndj_t * zwndj_t ) * tmask(ji,jj,1) 
    484484            END DO 
     
    490490            DO ji = fs_2, fs_jpim1   ! vect. opt. 
    491491               p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj) + z_wnds_t(ji,jj) )                          & 
    492                   &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj) + sf(jp_wndi)%fnow(ji,jj) ) - pui(ji,jj) ) 
     492                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - pui(ji,jj) ) 
    493493               p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1) + z_wnds_t(ji,jj) )                          & 
    494                   &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1) + sf(jp_wndj)%fnow(ji,jj) ) - pvi(ji,jj) ) 
     494                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - pvi(ji,jj) ) 
    495495            END DO 
    496496         END DO 
     
    515515               zst3 = pst(ji,jj,jl) * zst2 
    516516               ! Short Wave (sw) 
    517                p_qsr(ji,jj,jl) = ( 1. - palb(ji,jj,jl) ) * sf(jp_qsr)%fnow(ji,jj) * tmask(ji,jj,1) 
     517               p_qsr(ji,jj,jl) = ( 1. - palb(ji,jj,jl) ) * sf(jp_qsr)%fnow(ji,jj,1) * tmask(ji,jj,1) 
    518518               ! Long  Wave (lw) 
    519                z_qlw(ji,jj,jl) = 0.95 * (  sf(jp_qlw)%fnow(ji,jj)       &                          
     519               z_qlw(ji,jj,jl) = 0.95 * (  sf(jp_qlw)%fnow(ji,jj,1)       &                          
    520520                  &                   - Stef * pst(ji,jj,jl) * zst3  ) * tmask(ji,jj,1) 
    521521               ! lw sensitivity 
     
    528528               ! ... turbulent heat fluxes 
    529529               ! Sensible Heat 
    530                z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj) ) 
     530               z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 
    531531               ! Latent Heat 
    532532               p_qla(ji,jj,jl) = MAX( 0.e0, rhoa * Ls  * Cice * z_wnds_t(ji,jj)   &                            
    533                   &                    * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj)  ) ) 
     533                  &                    * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
    534534               ! Latent heat sensitivity for ice (Dqla/Dt) 
    535535               p_dqla(ji,jj,jl) = zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
     
    561561        
    562562!CDIR COLLAPSE 
    563       p_tpr(:,:) = sf(jp_prec)%fnow(:,:) * rn_pfac      ! total precipitation [kg/m2/s] 
    564 !CDIR COLLAPSE 
    565       p_spr(:,:) = sf(jp_snow)%fnow(:,:) * rn_pfac      ! solid precipitation [kg/m2/s] 
     563      p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s] 
     564!CDIR COLLAPSE 
     565      p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s] 
    566566      CALL iom_put( 'snowpre', p_spr )                  ! Snow precipitation  
    567567      ! 
  • branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcflx.F90

    r2075 r2077  
    126126         ENDIF 
    127127         DO ji= 1, jpfld 
    128             ALLOCATE( sf(ji)%fnow(jpi,jpj) ) 
    129             ALLOCATE( sf(ji)%fdta(jpi,jpj,2) ) 
     128            ALLOCATE( sf(ji)%fnow(jpi,jpj,1) ) 
     129            ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) ) 
    130130         END DO 
    131131 
     
    145145         DO jj = 1, jpj 
    146146            DO ji = 1, jpi 
    147                utau(ji,jj) = sf(jp_utau)%fnow(ji,jj) 
    148                vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj) 
    149                qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj) - sf(jp_qsr)%fnow(ji,jj) 
    150                qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj) 
    151                emp (ji,jj) = sf(jp_emp )%fnow(ji,jj) 
     147               utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
     148               vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
     149               qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 
     150               qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1) 
     151               emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 
    152152            END DO 
    153153         END DO 
  • branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r2075 r2077  
    8181            CALL ctl_stop( 'sbc_ice_if: unable to allocate sf_ice structure' )   ;   RETURN 
    8282         ENDIF 
    83          ALLOCATE( sf_ice(1)%fnow(jpi,jpj) ) 
    84          ALLOCATE( sf_ice(1)%fdta(jpi,jpj,2) ) 
     83         ALLOCATE( sf_ice(1)%fnow(jpi,jpj,1) ) 
     84         ALLOCATE( sf_ice(1)%fdta(jpi,jpj,1,2) ) 
    8585 
    8686 
     
    107107               ! 
    108108               zt_fzp  = fr_i(ji,jj)                        ! freezing point temperature 
    109                zfr_obs = sf_ice(1)%fnow(ji,jj)              ! observed ice cover 
     109               zfr_obs = sf_ice(1)%fnow(ji,jj,1)              ! observed ice cover 
    110110               !                                            ! ocean ice fraction (0/1) from the freezing point temperature 
    111111               IF( sst_m(ji,jj) <= zt_fzp ) THEN   ;   fr_i(ji,jj) = 1.e0 
  • branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90

    r2076 r2077  
    88   !! History :  1.0   !  06-2006  (G. Madec)  from icestp_2.F90 
    99   !!            3.0   !  08-2008  (S. Masson, E. .... ) coupled interface 
    10    !!            3.3   !  05-2009  (G.Garric) addition of the lim2_evp case 
    1110   !!---------------------------------------------------------------------- 
    1211#if defined key_lim2 
     
    5453   PUBLIC sbc_ice_lim_2 ! routine called by sbcmod.F90 
    5554    
     55   CHARACTER(len=1) ::   cl_grid = 'B'     ! type of grid used in ice dynamics 
     56 
    5657   !! * Substitutions 
    5758#  include "domzgr_substitute.h90" 
     
    171172         !  Ice model step  ! 
    172173         ! ---------------- ! 
    173          numit = numit + nn_fsbc                                             ! Ice model time step 
    174  
    175                                         CALL lim_rst_opn_2  ( kt )           ! Open Ice restart file 
    176          IF( .NOT. lk_c1d ) THEN                                             ! Ice dynamics & transport (not in 1D case) 
     174 
     175                                        CALL lim_rst_opn_2  ( kt )      ! Open Ice restart file 
     176         IF( .NOT. lk_c1d ) THEN                                        ! Ice dynamics & transport (not in 1D case) 
    177177                                        CALL lim_dyn_2      ( kt )           ! Ice dynamics    ( rheology/dynamics ) 
    178178                                        CALL lim_trp_2      ( kt )           ! Ice transport   ( Advection/diffusion ) 
  • branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r2075 r2077  
    7575               CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' )   ;   RETURN 
    7676            ENDIF 
    77             ALLOCATE( sf_rnf(1)%fnow(jpi,jpj) ) 
    78             ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,2) ) 
     77            ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1) ) 
     78            ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 
    7979         ENDIF 
    8080         CALL sbc_rnf_init(sf_rnf) 
     
    9393            DO jj = 1, jpj 
    9494               DO ji = 1, jpi 
    95                   IF( gphit(ji,jj) > 40 .AND. gphit(ji,jj) < 65 )   sf_rnf(1)%fnow(ji,jj) = 0.85 * sf_rnf(1)%fnow(ji,jj) 
     95                  IF( gphit(ji,jj) > 40 .AND. gphit(ji,jj) < 65 )   sf_rnf(1)%fnow(ji,jj,1) = 0.85 * sf_rnf(1)%fnow(ji,jj,1) 
    9696               END DO 
    9797            END DO 
     
    101101 
    102102         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 
    103             emp (:,:) = emp (:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:) ) 
    104             emps(:,:) = emps(:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:) ) 
     103            emp (:,:) = emp (:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:,1) ) 
     104            emps(:,:) = emps(:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:,1) ) 
    105105            CALL iom_put( "runoffs", sf_rnf(1)%fnow )         ! runoffs 
    106106         ENDIF 
  • branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcssr.F90

    r2075 r2077  
    115115               CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sst structure' )   ;   RETURN 
    116116            ENDIF 
    117             ALLOCATE( sf_sst(1)%fnow(jpi,jpj) ) 
    118             ALLOCATE( sf_sst(1)%fdta(jpi,jpj,2) ) 
     117            ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1) ) 
     118            ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2) ) 
    119119            ! 
    120120            ! fill sf_sst with sn_sst and control print 
     
    128128               CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sss structure' )   ;   RETURN 
    129129            ENDIF 
    130             ALLOCATE( sf_sss(1)%fnow(jpi,jpj) ) 
    131             ALLOCATE( sf_sss(1)%fdta(jpi,jpj,2) ) 
     130            ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1) ) 
     131            ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2) ) 
    132132            ! 
    133133            ! fill sf_sss with sn_sss and control print 
     
    153153               DO jj = 1, jpj 
    154154                  DO ji = 1, jpi 
    155                      zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj) ) 
     155                     zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) 
    156156                     qns(ji,jj) = qns(ji,jj) + zqrp 
    157157                     qrp(ji,jj) = zqrp 
     
    167167                  DO ji = 1, jpi 
    168168                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    169                         &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj) )   & 
     169                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   & 
    170170                        &        / ( sss_m(ji,jj) + 1.e-20   ) 
    171171                     emps(ji,jj) = emps(ji,jj) + zerp 
     
    182182                  DO ji = 1, jpi                             
    183183                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    184                         &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj) )   & 
     184                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   & 
    185185                        &        / ( sss_m(ji,jj) + 1.e-20   ) 
    186186                     IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) ) 
  • branches/devmercator2010/NEMO/OPA_SRC/TRA/traqsr.F90

    r2075 r2077  
    142142!CDIR NOVERRCHK 
    143143                  DO ji = 1, jpi 
    144                      zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj) ) ) 
     144                     zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) 
    145145                     irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 
    146146                     zekb(ji,jj) = rkrgb(1,irgb) 
     
    334334                  CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_chl structure' )   ;   RETURN 
    335335               ENDIF 
    336                ALLOCATE( sf_chl(1)%fnow(jpi,jpj)   ) 
    337                ALLOCATE( sf_chl(1)%fdta(jpi,jpj,2) ) 
     336               ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1)   ) 
     337               ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) ) 
    338338               !                                        ! fill sf_chl with sn_chl and control print 
    339339               CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init',   & 
  • branches/devmercator2010/NVTK/INSTALL/JOBS/job_ORCA2_LIM.ksh

    r2075 r2077  
    196196if [ "${USE_IOSERVER}" = "true" ] 
    197197then 
    198     cp ${WORK}/../bin/ioserver ioserver 
     198    cp ${MAINDIR}/modipsl/bin/ioserver ioserver 
    199199    chmod 777 ioserver 
    200200fi 
  • branches/devmercator2010/NVTK/INSTALL/JOBS/job_ORCA2_LIM3.ksh

    r2075 r2077  
    192192if [ "${USE_IOSERVER}" = "true" ] 
    193193then 
    194     cp ${WORK}/../bin/ioserver ioserver 
     194    cp ${MAINDIR}/modipsl/bin/ioserver ioserver 
    195195    chmod 777 ioserver 
    196196fi 
Note: See TracChangeset for help on using the changeset viewer.