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

Changeset 2075


Ignore:
Timestamp:
2010-09-08T17:46:37+02:00 (14 years ago)
Author:
cbricaud
Message:

add change from dev_1784_WEEK

Location:
branches/devmercator2010
Files:
18 edited

Legend:

Unmodified
Added
Removed

  • branches/devmercator2010/CONFIG/ORCA2_LIM/EXP00/AA_job

    r1782 r2075  
    117117 
    118118#- Files for the configuration and ocean dynamics 
    119 Rapatrie ${R_TMP} ORCA2_LIM_nemo_v3.2.tar 
     119Rapatrie ${R_TMP} ORCA2_LIM_nemo_v3.1.tar 
    120120 
    121121ls -alF 

  • branches/devmercator2010/CONFIG/ORCA2_LIM/EXP00/namelist

    r2072 r2075  
    275275   rn_alphdi   =    0.72   !  (Pyane, 1972) 
    276276/ 
    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 / 
     277 
    295278!!====================================================================== 
    296279!!               ***  Lateral boundary condition  *** 
    … …  
    434417   ln_traadv_muscl2 =  .false.  !  MUSCL2 scheme + cen2 at boundaries   
    435418   ln_traadv_ubs    =  .false.  !  UBS scheme                  
    436    !ln_traadv_ppm    =  .true.  !  UBS scheme                  
    437419/ 
    438420!----------------------------------------------------------------------- 
    … …  
    716698&namptr       !   Poleward Transport Diagnostic 
    717699!----------------------------------------------------------------------- 
    718    ln_diaptr  = .false.     !  Poleward heat and salt transport (T) or not (F) 
     700   ln_diaptr  = .true.     !  Poleward heat and salt transport (T) or not (F) 
    719701   ln_diaznl  = .true.     !  Add zonal means and meridional stream functions 
    720702   ln_subbas  = .true.     !  Atlantic/Pacific/Indian basins computation (T) or not  

  • branches/devmercator2010/CONFIG/ORCA2_LIM_PISCES/EXP00/AA_job

    r1782 r2075  
    117117 
    118118#- Files for the configuration and ocean dynamics 
    119 Rapatrie ${R_TMP} ORCA2_LIM_nemo_v3.2.tar 
     119Rapatrie ${R_TMP} ORCA2_LIM_nemo_v3.1.tar 
    120120Rapatrie ${R_TMP} INPUTS_INIT_v3.tar 
    121121Rapatrie ${R_TMP} INPUTS_PISCES_v3.tar 

  • branches/devmercator2010/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist

    r2072 r2075  
    275275   rn_alphdi   =    0.72   !  (Pyane, 1972) 
    276276/ 
    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 / 
     277 
    295278!!====================================================================== 
    296279!!               ***  Lateral boundary condition  *** 

  • branches/devmercator2010/NEMO/OPA_SRC/DOM/daymod.F90

    r1730 r2075  
    6767      !!              - nmonth_len, nyear_len, nmonth_half, nmonth_end through day_mth 
    6868      !!---------------------------------------------------------------------- 
     69      INTEGER :: inbday, irest 
     70      REAL(wp) :: zjul 
     71      !!---------------------------------------------------------------------- 
    6972 
    7073      ! all calendar staff is based on the fact that MOD( rday, rdttra(1) ) == 0 
    … …  
    105108      ! day since january 1st 
    106109      nday_year = nday + SUM( nmonth_len(1:nmonth - 1) ) 
    107        
     110 
     111      !compute number of days between last monday and today       
     112      IF( nn_leapy==1 )THEN 
     113         CALL ymds2ju( 1900, 01, 01, 0.0, zjul )  ! compute julian day value of 01.01.1900 (monday) 
     114         inbday = INT(fjulday) - NINT(zjul)       ! compute nb day between  01.01.1900 and current day fjulday  
     115         irest = MOD(inbday,7)                    ! compute nb day between last monday and current day fjulday  
     116         IF(irest==0 )irest = 7  
     117      ENDIF 
     118 
    108119      ! number of seconds since the beginning of current year/month at the middle of the time-step 
    109120      nsec_year  = nday_year * nsecd - ndt05   ! 1 time step before the middle of the first time step 
    110121      nsec_month = nday      * nsecd - ndt05   ! because day will be called at the beginning of step 
    111122      nsec_day   =             nsecd - ndt05 
     123      nsec_week  = 0 
     124      IF( nn_leapy==1 ) nsec_week  = irest     * nsecd - ndt05 
    112125 
    113126      ! control print 
    114127      IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i6)')' ==============>> 1/2 time step before the start of the run DATE Y/M/D = ',   & 
    115            &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day 
     128           &                   nyear, '/', nmonth, '/', nday, '  nsec_day:', nsec_day, '  nsec_week:', nsec_week 
    116129 
    117130      ! Up to now, calendar parameters are related to the end of previous run (nit000-1) 
    … …  
    200213      nsec_year  = nsec_year  + ndt  
    201214      nsec_month = nsec_month + ndt                  
     215      IF( nn_leapy==1 ) nsec_week  = nsec_week  + ndt 
    202216      nsec_day   = nsec_day   + ndt                 
    203217      adatrj  = adatrj  + rdttra(1) / rday 
    … …  
    228242         ndastp = nyear * 10000 + nmonth * 100 + nday   ! NEW date 
    229243         ! 
     244         !compute first day of the year in julian days 
     245         CALL ymds2ju( nyear, 01, 01, 0.0, fjulstartyear ) 
     246         ! 
    230247         IF(lwp) WRITE(numout,'(a,i8,a,i4.4,a,i2.2,a,i2.2,a,i3.3)') '======>> time-step =', kt,   & 
    231248              &   '      New day, DATE Y/M/D = ', nyear, '/', nmonth, '/', nday, '      nday_year = ', nday_year 
    232249         IF(lwp) WRITE(numout,'(a,i8,a,i7,a,i5)') '         nsec_year = ', nsec_year,   & 
    233               &   '   nsec_month = ', nsec_month, '   nsec_day = ', nsec_day 
    234       ENDIF 
     250              &   '   nsec_month = ', nsec_month, '   nsec_day = ', nsec_day, '   nsec_week = ', nsec_week 
     251      ENDIF 
     252 
     253      IF( nsec_week .GT. 7*86400 ) nsec_week = ndt05 
    235254       
    236255      IF(ln_ctl) THEN 

  • branches/devmercator2010/NEMO/OPA_SRC/DOM/dom_oce.F90

    r2071 r2075  
    195195   !! calendar variables 
    196196   !! --------------------------------------------------------------------- 
    197    INTEGER , PUBLIC ::   nyear       !: current year 
    198    INTEGER , PUBLIC ::   nmonth      !: current month 
    199    INTEGER , PUBLIC ::   nday        !: current day of the month 
    200    INTEGER , PUBLIC ::   ndastp      !: time step date in yyyymmdd format 
    201    INTEGER , PUBLIC ::   nday_year   !: current day counted from jan 1st of the current year 
    202    INTEGER , PUBLIC ::   nsec_year   !: current time step counted in second since 00h jan 1st of the current year 
    203    INTEGER , PUBLIC ::   nsec_month  !: current time step counted in second since 00h 1st day of the current month 
    204    INTEGER , PUBLIC ::   nsec_day    !: current time step counted in second since 00h of the current day 
    205    REAL(wp), PUBLIC ::   fjulday     !: julian day  
    206    REAL(wp), PUBLIC ::   adatrj      !: number of elapsed days since the begining of the whole simulation 
    207    !                                 !: (cumulative duration of previous runs that may have used different time-step size) 
     197   INTEGER , PUBLIC ::   nyear         !: current year 
     198   INTEGER , PUBLIC ::   nmonth        !: current month 
     199   INTEGER , PUBLIC ::   nday          !: current day of the month 
     200   INTEGER , PUBLIC ::   ndastp        !: time step date in yyyymmdd format 
     201   INTEGER , PUBLIC ::   nday_year     !: current day counted from jan 1st of the current year 
     202   INTEGER , PUBLIC ::   nsec_year     !: current time step counted in second since 00h jan 1st of the current year 
     203   INTEGER , PUBLIC ::   nsec_month    !: current time step counted in second since 00h 1st day of the current month 
     204   INTEGER , PUBLIC ::   nsec_week     !: current time step counted in second since 00h of last monday 
     205   INTEGER , PUBLIC ::   nsec_day      !: current time step counted in second since 00h of the current day 
     206   REAL(wp), PUBLIC ::   fjulday       !: current julian day  
     207   REAL(wp), PUBLIC ::   fjulstartyear !: first day of the current year in julian days 
     208   REAL(wp), PUBLIC ::   adatrj        !: number of elapsed days since the begining of the whole simulation 
     209   !                                   !: (cumulative duration of previous runs that may have used different time-step size) 
    208210   INTEGER , PUBLIC, DIMENSION(0: 1) ::   nyear_len     !: length in days of the previous/current year 
    209211   INTEGER , PUBLIC, DIMENSION(0:13) ::   nmonth_len    !: length in days of the months of the current year 

  • branches/devmercator2010/NEMO/OPA_SRC/DTA/dtasal.F90

    r2071 r2075  
    1313   USE oce             ! ocean dynamics and tracers 
    1414   USE dom_oce         ! ocean space and time domain 
    15    USE fldread         ! read input fields 
    1615   USE in_out_manager  ! I/O manager 
    1716   USE phycst          ! physical constants 
    … …  
    2827   !! * Shared module variables 
    2928   LOGICAL , PUBLIC, PARAMETER ::   lk_dtasal = .TRUE.    !: salinity data flag 
    30    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   s_dta    !: salinity data at given time-step 
     29   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: 
     30      s_dta       !: salinity data at given time-step 
    3131 
    3232   !! * Module variables 
    33    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_sal       ! structure of input SST (file informations, fields read) 
     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 
    3438 
    3539   !! * Substitutions 
    … …  
    4852 
    4953   SUBROUTINE dta_sal( kt ) 
    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 
     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 ::   & 
     82          il0, il1, ii0, ii1, ij0, ij1   ! temporary integers          
     83# endif 
     84     REAL(wp) ::   zxy, zl 
     85#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) ::   & 
     91          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  
     132         
     133#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) 
     138#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         
    75149#if defined key_tradmp 
    76       INTEGER ::   & 
    77           il0, il1, ii0, ii1, ij0, ij1   ! temporary integers          
    78 #endif 
    79       REAL(wp) ::   zxy, zl 
    80 #if defined key_orca_lev10 
    81       INTEGER   :: ikr, ikw, ikt, jjk 
    82       REAL(wp)  :: zfac 
    83 #endif 
    84       REAL(wp), DIMENSION(jpk) ::   & 
    85           zsaldta            ! auxiliary array for interpolation 
    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 
     150        IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN 
     151            
     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 
    180208#endif    
    181209         
    182210#if defined key_orca_lev10 
    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')         
    200 #else 
    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 
     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 
    225257            
    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 
     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) 
    259305 
    260306   END SUBROUTINE dta_sal 

  • branches/devmercator2010/NEMO/OPA_SRC/DTA/dtatem.F90

    r2071 r2075  
    1313   USE oce             ! ocean dynamics and tracers 
    1414   USE dom_oce         ! ocean space and time domain 
    15    USE fldread         ! read input fields 
    1615   USE in_out_manager  ! I/O manager 
    1716   USE phycst          ! physical constants 
    … …  
    2726   !! * Shared module variables 
    2827   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatem = .TRUE.   !: temperature data flag 
    29    REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::  t_dta    !: temperature data at given time-step 
     28   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) ::   &  !: 
     29      t_dta             !: temperature data at given time-step 
    3030 
    3131   !! * Module variables 
    32    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tem      ! structure of input SST (file informations, fields read) 
     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 
    3337 
    3438   !! * Substitutions 
    … …  
    6973      !!   8.5  !  02-09  (G. Madec)  F90: Free form and module 
    7074      !!---------------------------------------------------------------------- 
     75      !! * Modules used 
     76      USE iom 
     77 
    7178      !! * Arguments 
    7279      INTEGER, INTENT( in ) ::   kt     ! ocean time-step 
    7380 
    7481      !! * Local declarations 
    75       INTEGER ::   ji, jj, jk, jl, jkk       ! dummy loop indicies 
     82      INTEGER ::   ji, jj, jl, jk, jkk       ! dummy loop indicies 
    7683      INTEGER ::   & 
    77         imois, iman, i15 , ik      ! temporary integers 
    78       INTEGER            :: ierror 
    79 #if defined key_tradmp 
     84         imois, iman, i15 , ik      ! temporary integers 
     85#  if defined key_tradmp 
    8086      INTEGER ::   & 
    8187         il0, il1, ii0, ii1, ij0, ij1   ! temporary integers 
    82 #endif 
     88# endif 
    8389      REAL(wp) ::   zxy, zl 
    8490#if defined key_orca_lev10 
    85       !!!REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: ztem 
     91      REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: ztem 
    8692      INTEGER   :: ikr, ikw, ikt, jjk  
    8793      REAL(wp)  :: zfac 
    8894#endif 
    89       REAL(wp), DIMENSION(jpk) ::   & 
     95      REAL(wp), DIMENSION(jpk,2) ::   & 
    9096         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. 
    9497      !!---------------------------------------------------------------------- 
    95       NAMELIST/namdta_tem/cn_dir,sn_tem 
    96   
    97       ! 1. Initialization  
     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 
    98109      ! ----------------------- 
    99110       
    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  
     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          
    133117      ENDIF 
     118       
    134119       
    135120      ! 2. Read monthly file 
    136121      ! ------------------- 
    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,*) 
     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,*) 
     151          
     152#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 
     166#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 
     188                  END DO 
     189               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 
     299            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 
    144307      ENDIF 
    145           
    146 #if defined key_tradmp 
    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') 
    217 #else 
    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 
    234                   END DO 
    235                END DO 
    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 
    244             WRITE(numout,*) 
    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 
     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 
    279322 
    280323#else 

  • branches/devmercator2010/NEMO/OPA_SRC/SBC/fldread.F90

    r2071 r2075  
    1515   USE oce             ! ocean dynamics and tracers 
    1616   USE dom_oce         ! ocean space and time domain 
     17   USE ioipsl, ONLY :   ymds2ju, ju2ymds   ! for calendar 
    1718   USE phycst          ! ??? 
    1819   USE in_out_manager  ! I/O manager 
    … …  
    2930      LOGICAL              ::   ln_tint     ! time interpolation or not (T/F) 
    3031      LOGICAL              ::   ln_clim     ! climatology or not (T/F) 
    31       CHARACTER(len = 7)   ::   cltype      ! type of data file 'daily', 'monthly' or yearly' 
     32      CHARACTER(len = 8)   ::   cltype      ! type of data file 'daily', 'monthly' or yearly' 
    3233      CHARACTER(len = 34)  ::   wname       ! generic name of a NetCDF weights file to be used, blank if not 
    3334      CHARACTER(len = 34)  ::   vcomp       ! symbolic component name if a vector that needs rotation 
    … …  
    4344      LOGICAL                         ::   ln_tint      ! time interpolation or not (T/F) 
    4445      LOGICAL                         ::   ln_clim      ! climatology or not (T/F) 
    45       CHARACTER(len = 7)              ::   cltype       ! type of data file 'daily', 'monthly' or yearly' 
     46      CHARACTER(len = 8)              ::   cltype       ! type of data file 'daily', 'monthly' or yearly' 
    4647      INTEGER                         ::   num          ! iom id of the jpfld files to be read 
    4748      INTEGER                         ::   nswap_sec    ! swapping time in second since Jan. 1st 00h of nit000 year 
    4849      INTEGER , DIMENSION(2)          ::   nrec_b       ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year) 
    4950      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 
     51      REAL(wp) , ALLOCATABLE, DIMENSION(:,:)   ::   fnow         ! input fields interpolated to now time step 
     52      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:) ::   fdta         ! 2 consecutive record of input fields 
    5253      CHARACTER(len = 256)            ::   wgtname      ! current name of the NetCDF weight file acting as a key 
    5354                                                        ! into the WGTLIST structure 
    … …  
    7879      INTEGER, DIMENSION(:,:,:), POINTER      ::   data_jpj     ! array of source integers 
    7980      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 
     81      REAL(wp), DIMENSION(:,:), POINTER       ::   fly_dta      ! array of values on input grid 
     82      REAL(wp), DIMENSION(:,:), POINTER       ::   col2         ! temporary array for reading in columns 
    8283   END TYPE WGT 
    8384 
    … …  
    120121 
    121122      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 ) 
    124123      INTEGER  ::   kw         ! index into wgts array 
    125124      INTEGER  ::   ireclast   ! last record to be read in the current year file 
    … …  
    145144            IF( sd(jf)%ln_tint ) THEN         ! time interpolation: swap before record field 
    146145!CDIR COLLAPSE 
    147                sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) 
    148                sd(jf)%rotn(1)       = sd(jf)%rotn(2) 
     146               sd(jf)%fdta(:,:,1) = sd(jf)%fdta(:,:,2) 
     147               sd(jf)%rotn(1)     = sd(jf)%rotn(2) 
    149148            ENDIF 
    150149 
    … …  
    159158 
    160159               ! last record to be read in the current file 
    161                IF( sd(jf)%nfreqh == -1 ) THEN 
    162                   IF(     sd(jf)%cltype == 'monthly'   ) THEN  ;   ireclast = 1 
    163                   ELSE                                         ;   ireclast = 12 
    164                   ENDIF 
     160               IF( sd(jf)%nfreqh == -1 ) THEN                  ;   ireclast = 12 
    165161               ELSE                              
    166                   IF(     sd(jf)%cltype == 'monthly'   ) THEN  ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh  
    167                   ELSEIF( sd(jf)%cltype == 'daily'     ) THEN  ;   ireclast = 24                      / sd(jf)%nfreqh 
    168                   ELSE                                         ;   ireclast = 24 * nyear_len(     1 ) / sd(jf)%nfreqh  
     162                  IF(     sd(jf)%cltype      == 'monthly' ) THEN  ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh  
     163                  ELSEIF( sd(jf)%cltype(1:4) == 'week'    ) THEN  ;   ireclast = 24.* 7                  / sd(jf)%nfreqh 
     164                  ELSEIF( sd(jf)%cltype      == 'daily'   ) THEN  ;   ireclast = 24                      / sd(jf)%nfreqh 
     165                  ELSE                                            ;   ireclast = 24 * nyear_len(     1 ) / sd(jf)%nfreqh  
    169166                  ENDIF 
    170167               ENDIF 
    … …  
    209206            IF( LEN(TRIM(sd(jf)%wgtname)) > 0 ) THEN 
    210207               CALL wgt_list( sd(jf), kw ) 
    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) ) 
     208               CALL fld_interp( sd(jf)%num, sd(jf)%clvar, kw, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) ) 
    213209            ELSE 
    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 
     210               CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) ) 
    220211            ENDIF 
    221212            sd(jf)%rotn(2) = .FALSE. 
    … …  
    256247                         utmp(:,:) = 0.0 
    257248                         vtmp(:,:) = 0.0 
    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                          ! 
     249                         CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->i', utmp(:,:) ) 
     250                         CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->j', vtmp(:,:) ) 
     251                         sd(jf)%fdta(:,:,nf) = utmp(:,:) 
     252                         sd(kf)%fdta(:,:,nf) = vtmp(:,:) 
    267253                         sd(jf)%rotn(nf) = .TRUE. 
    268254                         sd(kf)%rotn(nf) = .TRUE. 
    … …  
    296282               ztintb =  1. - ztinta 
    297283!CDIR COLLAPSE 
    298                sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2) 
     284               sd(jf)%fnow(:,:) = ztintb * sd(jf)%fdta(:,:,1) + ztinta * sd(jf)%fdta(:,:,2) 
    299285            ELSE 
    300286               IF(lwp .AND. kt - nit000 <= 100 ) THEN 
    … …  
    304290               ENDIF 
    305291!CDIR COLLAPSE 
    306                sd(jf)%fnow(:,:,:) = sd(jf)%fdta(:,:,:,2)   ! piecewise constant field 
     292               sd(jf)%fnow(:,:) = sd(jf)%fdta(:,:,2)   ! piecewise constant field 
    307293  
    308294            ENDIF 
    … …  
    329315      TYPE(FLD), INTENT(inout) ::   sdjf        ! input field related variables 
    330316      !! 
    331       LOGICAL :: llprevyr       ! are we reading previous year  file? 
    332       LOGICAL :: llprevmth      ! are we reading previous month file? 
    333       LOGICAL :: llprevday      ! are we reading previous day   file? 
    334       LOGICAL :: llprev         ! llprevyr .OR. llprevmth .OR. llprevday 
    335       INTEGER :: idvar          ! variable id  
    336       INTEGER :: inrec          ! number of record existing for this variable 
     317      LOGICAL :: llprevyr              ! are we reading previous year  file? 
     318      LOGICAL :: llprevmth             ! are we reading previous month file? 
     319      LOGICAL :: llprevweek            ! are we reading previous week file? 
     320      LOGICAL :: llprevday             ! are we reading previous day   file? 
     321      LOGICAL :: llprev                ! llprevyr .OR. llprevmth .OR. llprevday 
     322      INTEGER :: idvar                 ! variable id  
     323      INTEGER :: inrec                 ! number of record existing for this variable 
    337324      INTEGER :: kwgt 
    338       INTEGER :: jk             !vertical loop variable 
    339       INTEGER :: ipk            !number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
     325      INTEGER :: iyear, imonth, iday   ! first day of the current file in yyyy mm dd 
     326      INTEGER :: isec_week             ! number of seconds since start of the weekly file 
    340327      CHARACTER(LEN=1000) ::   clfmt   ! write format 
    341328      !!--------------------------------------------------------------------- 
    342  
     329       
    343330      ! some default definitions... 
    344331      sdjf%num = 0   ! default definition for non-opened file 
    345332      IF( sdjf%ln_clim )   sdjf%clname = TRIM( sdjf%clrootname )   ! file name defaut definition, never change in this case 
    346       llprevyr  = .FALSE. 
    347       llprevmth = .FALSE. 
    348       llprevday = .FALSE. 
     333      llprevyr   = .FALSE. 
     334      llprevmth  = .FALSE. 
     335      llprevweek = .FALSE. 
     336      llprevday  = .FALSE. 
     337      isec_week  = 0 
    349338             
    350339      ! define record informations 
    … …  
    357346               IF( sdjf%cltype == 'monthly' ) THEN   ! monthly file 
    358347                  sdjf%nrec_b(1) = 1                                                       ! force to read the unique record 
    359                   llprevmth = .TRUE.                                                       ! use previous month file? 
     348                  llprevmth = .NOT. sdjf%ln_clim                                           ! use previous month file? 
    360349                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file? 
    361350               ELSE                                  ! yearly file 
    … …  
    368357                  llprevmth = .NOT. sdjf%ln_clim                                           ! use previous month file? 
    369358                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file? 
     359               ELSE IF ( sdjf%cltype(1:4) == 'week' ) THEN !weekly file 
     360                  isec_week = 86400 * 7 
     361                  sdjf%nrec_b(1) = 24. / sdjf%nfreqh * 7                                   ! last record of previous weekly file 
    370362               ELSEIF( sdjf%cltype == 'daily' ) THEN ! daily file 
    371363                  sdjf%nrec_b(1) = 24 / sdjf%nfreqh                                        ! last record of previous day 
    … …  
    379371            ENDIF 
    380372         ENDIF 
    381          llprev = llprevyr .OR. llprevmth .OR. llprevday 
    382  
    383          CALL fld_clopn( sdjf, nyear  - COUNT((/llprevyr /))                                              ,               & 
    384             &                  nmonth - COUNT((/llprevmth/)) + 12                   * COUNT((/llprevyr /)),               & 
    385             &                  nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)), .NOT. llprev ) 
     373         llprev = llprevyr .OR. llprevmth .OR. llprevweek .OR. llprevday 
     374 
     375         IF ( sdjf%cltype(1:4) == 'week' ) THEN 
     376            isec_week  = ksec_week( sdjf%cltype(6:8) ) 
     377            if(lwp)write(numout,*)'cbr test2 isec_week = ',isec_week 
     378            llprevmth  = ( isec_week .GT. nsec_month ) 
     379            llprevyr   = llprevmth  .AND. nmonth==1 
     380         ENDIF 
     381         ! 
     382         iyear  = nyear  - COUNT((/llprevyr /)) 
     383         imonth = nmonth - COUNT((/llprevmth/)) + 12* COUNT((/llprevyr /)) 
     384         iday   = nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - INT( isec_week )/86400 
     385         ! 
     386         CALL fld_clopn( sdjf , iyear , imonth , iday , .NOT. llprev ) 
    386387 
    387388         ! if previous year/month/day file does not exist, we switch to the current year/month/day 
    … …  
    402403 
    403404         ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read 
    404           
    405405         IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
    406406            CALL wgt_list( sdjf, kwgt ) 
    407             ipk = SIZE(sdjf%fdta,3) 
    408             CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, ipk, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 
     407            CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, sdjf%fdta(:,:,2), sdjf%nrec_b(1) ) 
    409408         ELSE 
    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 
     409            CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,2), sdjf%nrec_b(1) ) 
    416410         ENDIF 
    417411         sdjf%rotn(2) = .FALSE. 
    … …  
    424418      ENDIF 
    425419 
    426  
    427       IF( sdjf%num == 0 )   CALL fld_clopn( sdjf, nyear, nmonth, nday )   ! make sure current year/month/day file is opened 
     420      ! make sure current year/month/day file is opened 
     421      IF( sdjf%num == 0 ) THEN 
     422         isec_week   = 0 
     423         llprevyr    = .FALSE. 
     424         llprevmth   = .FALSE. 
     425         llprevweek  = .FALSE. 
     426         ! 
     427         IF ( sdjf%cltype(1:4) == 'week' ) THEN 
     428            isec_week  = ksec_week( sdjf%cltype(6:8) ) 
     429            llprevmth  = ( isec_week .GT. nsec_month ) 
     430            llprevyr   = llprevmth  .AND. nmonth==1 
     431         ENDIF 
     432         ! 
     433         iyear  = nyear  - COUNT((/llprevyr /)) 
     434         imonth = nmonth - COUNT((/llprevmth/)) + 12* COUNT((/llprevyr /)) 
     435         iday   = nday   + nmonth_len(nmonth-1) * COUNT((/llprevmth/)) - isec_week/86400 
     436         ! 
     437         CALL fld_clopn( sdjf, iyear, imonth, iday ) 
     438      ENDIF  
    428439 
    429440      sdjf%nswap_sec = nsec_year + nsec1jan000 - 1   ! force read/update the after data in the following part of fld_read  
    430       
     441 
    431442   END SUBROUTINE fld_init 
    432443 
    … …  
    446457      REAL(wp) ::   ztmp        ! temporary variable 
    447458      INTEGER  ::   ifreq_sec   ! frequency mean (in seconds) 
     459      INTEGER  ::   isec_week   ! number of seconds since the start of the weekly file 
    448460      !!---------------------------------------------------------------------- 
    449461      ! 
    … …  
    462474            !       forcing record :  nmonth  
    463475            !                             
    464             ztmp  = 0.e0 
    465             IF(  REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) .GT. 0.5 ) ztmp  = 1.0 
     476            ztmp  = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 
    466477         ELSE 
    467478            ztmp  = 0.e0 
    … …  
    473484         ENDIF 
    474485 
    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 
     486         sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define after  record number and time 
     487         irec = irec - 1                                                ! move back to previous record 
     488         sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define before record number and time 
    492489         ! 
    493490      ELSE                              ! higher frequency mean (in hours) 
    494491         ! 
    495492         ifreq_sec = sdjf%nfreqh * 3600   ! frequency mean (in seconds) 
     493         IF( sdjf%cltype(1:4) == 'week'    ) isec_week = ksec_week( sdjf%cltype(6:8)) !since the first day of the current week 
    496494         ! number of second since the beginning of the file 
    497          IF(     sdjf%cltype == 'monthly' ) THEN   ;   ztmp = REAL(nsec_month,wp)   ! since 00h on the 1st day of the current month 
    498          ELSEIF( sdjf%cltype == 'daily'   ) THEN   ;   ztmp = REAL(nsec_day  ,wp)   ! since 00h of the current day 
    499          ELSE                                      ;   ztmp = REAL(nsec_year ,wp)   ! since 00h on Jan 1 of the current year 
     495         IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ztmp = REAL(nsec_month ,wp)  ! since 00h on the 1st day of the current month 
     496         ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   ztmp = REAL(isec_week  ,wp)  ! since the first day of the current week 
     497         ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   ztmp = REAL(nsec_day   ,wp)  ! since 00h of the current day 
     498         ELSE                                           ;   ztmp = REAL(nsec_year  ,wp)  ! since 00h on Jan 1 of the current year 
    500499         ENDIF 
    501500         IF( sdjf%ln_tint ) THEN                ! time interpolation, shift by 1/2 record 
    … …  
    533532         ! after record index and second since Jan. 1st 00h of nit000 year 
    534533         sdjf%nrec_a(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /) 
    535          IF( sdjf%cltype == 'monthly' )   &   ! add the number of seconds between 00h Jan 1 and the end of previous month 
     534         IF( sdjf%cltype == 'monthly' )       &   ! add the number of seconds between 00h Jan 1 and the end of previous month 
    536535            sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * SUM(nmonth_len(1:nmonth -1))   ! ok if nmonth=1 
    537          IF( sdjf%cltype == 'daily'   )   &   ! add the number of seconds between 00h Jan 1 and the end of previous day 
     536         IF( sdjf%cltype(1:4) == 'week'   )   &   ! add the number of seconds between 00h Jan 1 and the end of previous week  
     537            sdjf%nrec_a(2) = sdjf%nrec_a(2) + ( nsec_year - isec_week ) 
     538         IF( sdjf%cltype == 'daily'   )       &   ! add the number of seconds between 00h Jan 1 and the end of previous day 
    538539            sdjf%nrec_a(2) = sdjf%nrec_a(2) + isecd * ( nday_year - 1 ) 
    539540 
    … …  
    541542         irec = irec - 1.                           ! move back to previous record 
    542543         sdjf%nrec_b(:) = (/ irec, ifreq_sec * irec - ifreq_sec / 2 + nsec1jan000 /) 
    543          IF( sdjf%cltype == 'monthly' )   &   ! add the number of seconds between 00h Jan 1 and the end of previous month 
     544         IF( sdjf%cltype == 'monthly' )       &   ! add the number of seconds between 00h Jan 1 and the end of previous month 
    544545            sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * SUM(nmonth_len(1:nmonth -1))   ! ok if nmonth=1 
    545          IF( sdjf%cltype == 'daily'   )   &   ! add the number of seconds between 00h Jan 1 and the end of previous day 
     546         IF( sdjf%cltype(1:4) == 'week'   )   &   ! add the number of seconds between 00h Jan 1 and the end of previous week 
     547            sdjf%nrec_b(2) = sdjf%nrec_b(2) + ( nsec_year - isec_week ) 
     548         IF( sdjf%cltype == 'daily'   )       &   ! add the number of seconds between 00h Jan 1 and the end of previous day 
    546549            sdjf%nrec_b(2) = sdjf%nrec_b(2) + isecd * ( nday_year - 1 ) 
    547550 
    … …  
    564567      !! ** Method  :    
    565568      !!---------------------------------------------------------------------- 
    566       TYPE(FLD), INTENT(inout)           ::   sdjf     ! input field related variables 
    567       INTEGER  , INTENT(in   )           ::   kyear    ! year value 
    568       INTEGER  , INTENT(in   )           ::   kmonth   ! month value 
    569       INTEGER  , INTENT(in   )           ::   kday     ! day value 
    570       LOGICAL  , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.) 
     569      TYPE(FLD), INTENT(inout)           ::   sdjf                      ! input field related variables 
     570      INTEGER  , INTENT(in   )           ::   kyear                     ! year value 
     571      INTEGER  , INTENT(in   )           ::   kmonth                    ! month value 
     572      INTEGER  , INTENT(in   )           ::   kday                      ! day value 
     573      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldstop                    ! stop if open to read a non-existing file (default = .TRUE.) 
     574      INTEGER                            ::   iyear, imonth, iday       ! firt day of the current week in yyyy mm dd 
     575      REAL(wp)                           ::   zsec, zjul                !temp variable 
    571576 
    572577      IF( sdjf%num /= 0 )   CALL iom_close( sdjf%num )   ! close file if already open 
    573578      ! build the new filename if not climatological data 
    574       IF( .NOT. sdjf%ln_clim ) THEN   ;   WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year 
    575          IF( sdjf%cltype /= 'yearly' )    WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname     ), kmonth   ! add month 
    576          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 
     579      sdjf%clname=TRIM(sdjf%clrootname) 
     580      ! 
     581      IF(  sdjf%cltype(1:4) == 'week' .AND. nn_leapy==0 )CALL ctl_stop( 'fld_clopn: weekly file and nn_leapy=0 are not compatible' ) 
     582      ! 
     583      IF( .NOT. sdjf%ln_clim ) THEN    
     584         WRITE(sdjf%clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year 
     585         IF( sdjf%cltype /= 'yearly'        )   &  
     586            &     WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname ), kmonth   ! add month 
     587         IF( sdjf%cltype == 'daily'  .OR. sdjf%cltype(1:4) == 'week' ) & 
     588            &     WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname ), kday     ! add day 
    580589      ENDIF 
    581590      CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 ) 
    … …  
    608617         sdf(jf)%ln_tint    = sdf_n(jf)%ln_tint 
    609618         sdf(jf)%ln_clim    = sdf_n(jf)%ln_clim 
    610          sdf(jf)%cltype     = sdf_n(jf)%cltype 
     619         IF( sdf(jf)%nfreqh == -1. ) THEN   ;   sdf(jf)%cltype = 'yearly' 
     620         ELSE                               ;   sdf(jf)%cltype = sdf_n(jf)%cltype 
     621         ENDIF 
    611622         sdf(jf)%wgtname = " " 
    612623         IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 )   sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname ) 
    … …  
    726737      INTEGER                                 ::   inum          ! temporary logical unit 
    727738      INTEGER                                 ::   id            ! temporary variable id 
    728       INTEGER                                 ::   ipk           ! temporary vertical dimension 
    729739      CHARACTER (len=5)                       ::   aname 
    730740      INTEGER , DIMENSION(3)                  ::   ddims 
    … …  
    891901         ! SA: +3 stencil is a patch to avoid out-of-bound computation in some configuration.  
    892902         ! a more robust solution will be given in next release 
    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) ) 
     903         ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3) ) 
     904         IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col2(2,ref_wgts(nxt_wgt)%jpjwgt+3) ) 
    896905 
    897906         nxt_wgt = nxt_wgt + 1 
    … …  
    903912   END SUBROUTINE fld_weight 
    904913 
    905    SUBROUTINE fld_interp(num, clvar, kw, kk, dta, nrec) 
     914   SUBROUTINE fld_interp(num, clvar, kw, dta, nrec) 
    906915      !!--------------------------------------------------------------------- 
    907916      !!                    ***  ROUTINE fld_interp  *** 
    … …  
    912921      !! ** Method  :    
    913922      !!---------------------------------------------------------------------- 
    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) 
     923      INTEGER,          INTENT(in)                        ::   num                 ! stream number 
     924      CHARACTER(LEN=*), INTENT(in)                        ::   clvar               ! variable name 
     925      INTEGER,          INTENT(in)                        ::   kw                  ! weights number 
     926      REAL(wp),         INTENT(inout), DIMENSION(jpi,jpj) ::   dta                 ! output field on model grid 
     927      INTEGER,          INTENT(in)                        ::   nrec                ! record number to read (ie time slice) 
    920928      !!  
    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 
     929      INTEGER, DIMENSION(2)                               ::   rec1,recn           ! temporary arrays for start and length 
     930      INTEGER                                             ::  jk, jn, jm           ! loop counters 
     931      INTEGER                                             ::  ni, nj               ! lengths 
     932      INTEGER                                             ::  jpimin,jpiwid        ! temporary indices 
     933      INTEGER                                             ::  jpjmin,jpjwid        ! temporary indices 
     934      INTEGER                                             ::  jpi1,jpi2,jpj1,jpj2  ! temporary indices 
    927935      !!---------------------------------------------------------------------- 
    928936      ! 
    … …  
    942950      rec1(1) = MAX( jpimin-1, 1 ) 
    943951      rec1(2) = MAX( jpjmin-1, 1 ) 
    944       rec1(3) = 1 
    945952      recn(1) = MIN( jpiwid+2, ref_wgts(kw)%ddims(1)-rec1(1)+1 ) 
    946953      recn(2) = MIN( jpjwid+2, ref_wgts(kw)%ddims(2)-rec1(2)+1 ) 
    947       recn(3) = kk 
    948954 
    949955      !! where we need to read it to 
    … …  
    953959      jpj2 = jpj1 + recn(2) - 1 
    954960 
    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  
     961      ref_wgts(kw)%fly_dta(:,:) = 0.0 
     962      CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2), nrec, rec1, recn) 
    962963 
    963964      !! first four weights common to both bilinear and bicubic 
    964965      !! note that we have to offset by 1 into fly_dta array because of halo 
    965       dta(:,:,:) = 0.0 
     966      dta(:,:) = 0.0 
    966967      DO jk = 1,4 
    967         DO jn = 1, nlcj 
    968           DO jm = 1,nlci 
     968        DO jn = 1, jpj 
     969          DO jm = 1,jpi 
    969970            ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    970971            nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    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) 
     972            dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1) 
    972973          END DO 
    973974        END DO 
    … …  
    978979        !! fix up halo points that we couldnt read from file 
    979980        IF( jpi1 == 2 ) THEN 
    980            ref_wgts(kw)%fly_dta(jpi1-1,:,:) = ref_wgts(kw)%fly_dta(jpi1,:,:) 
     981           ref_wgts(kw)%fly_dta(jpi1-1,:) = ref_wgts(kw)%fly_dta(jpi1,:) 
    981982        ENDIF 
    982983        IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 
    983            ref_wgts(kw)%fly_dta(jpi2+1,:,:) = ref_wgts(kw)%fly_dta(jpi2,:,:) 
     984           ref_wgts(kw)%fly_dta(jpi2+1,:) = ref_wgts(kw)%fly_dta(jpi2,:) 
    984985        ENDIF 
    985986        IF( jpj1 == 2 ) THEN 
    986            ref_wgts(kw)%fly_dta(:,jpj1-1,:) = ref_wgts(kw)%fly_dta(:,jpj1,:) 
     987           ref_wgts(kw)%fly_dta(:,jpj1-1) = ref_wgts(kw)%fly_dta(:,jpj1) 
    987988        ENDIF 
    988989        IF( jpj2 + jpjmin - 1 == ref_wgts(kw)%ddims(2)+1 .AND. jpj2 .lt. jpjwid+2 ) THEN 
    989            ref_wgts(kw)%fly_dta(:,jpj2+1,:) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2,:) - ref_wgts(kw)%fly_dta(:,jpj2-1,:) 
     990           ref_wgts(kw)%fly_dta(:,jpj2+1) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2) - ref_wgts(kw)%fly_dta(:,jpj2-1) 
    990991        ENDIF 
    991992 
    … …  
    10001001           IF( jpi1 == 2 ) THEN 
    10011002              rec1(1) = ref_wgts(kw)%ddims(1) - 1 
    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,:) 
     1003              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn) 
     1004              ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2) = ref_wgts(kw)%col2(ref_wgts(kw)%offset+1,jpj1:jpj2) 
    10091005           ENDIF 
    10101006           IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 
    10111007              rec1(1) = 1 
    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,:) 
     1008              CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn) 
     1009              ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2) = ref_wgts(kw)%col2(2-ref_wgts(kw)%offset,jpj1:jpj2) 
    10191010           ENDIF 
    10201011        ENDIF 
    … …  
    10221013        ! gradient in the i direction 
    10231014        DO jk = 1,4 
    1024           DO jn = 1, nlcj 
    1025             DO jm = 1,nlci 
     1015          DO jn = 1, jpj 
     1016            DO jm = 1,jpi 
    10261017              ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    10271018              nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    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,:)) 
     1019              dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 *         & 
     1020                               (ref_wgts(kw)%fly_dta(ni+2,nj+1) - ref_wgts(kw)%fly_dta(ni,nj+1)) 
    10301021            END DO 
    10311022          END DO 
    … …  
    10341025        ! gradient in the j direction 
    10351026        DO jk = 1,4 
    1036           DO jn = 1, nlcj 
    1037             DO jm = 1,nlci 
     1027          DO jn = 1, jpj 
     1028            DO jm = 1,jpi 
    10381029              ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    10391030              nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    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,:)) 
     1031              dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 *         & 
     1032                               (ref_wgts(kw)%fly_dta(ni+1,nj+2) - ref_wgts(kw)%fly_dta(ni+1,nj)) 
    10421033            END DO 
    10431034          END DO 
    … …  
    10501041              ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    10511042              nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    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  ,:))) 
     1043              dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( & 
     1044                               (ref_wgts(kw)%fly_dta(ni+2,nj+2) - ref_wgts(kw)%fly_dta(ni  ,nj+2)) -   & 
     1045                               (ref_wgts(kw)%fly_dta(ni+2,nj  ) - ref_wgts(kw)%fly_dta(ni  ,nj  ))) 
    10551046            END DO 
    10561047          END DO 
    … …  
    10601051 
    10611052   END SUBROUTINE fld_interp 
    1062    
     1053 
     1054   FUNCTION ksec_week( cdday ) 
     1055      !!--------------------------------------------------------------------- 
     1056      !!                    ***  FUNCTION kshift_week ***  
     1057      !! 
     1058      !! ** Purpose :   
     1059      !! 
     1060      !! ** Method  : 
     1061      !!--------------------------------------------------------------------- 
     1062      CHARACTER(len=*), INTENT(in)   ::   cdday   !3 first letters of the first day of the weekly file 
     1063      !! 
     1064      INTEGER                        ::   ksec_week  ! output variable 
     1065      INTEGER                        ::   ijul       !temp variable 
     1066      INTEGER                        ::   ishift     !temp variable 
     1067      CHARACTER(len=3),DIMENSION(7)  ::   cl_week  
     1068      !!---------------------------------------------------------------------- 
     1069      cl_week = (/"sun","sat","fri","thu","wed","tue","mon"/) 
     1070      DO ijul=1,7 
     1071         IF(  cl_week(ijul)==TRIM(cdday) ) EXIT 
     1072      ENDDO 
     1073      IF( ijul .GT. 7 ) CALL ctl_stop( 'ksec_week: wrong day for sdjf%cltype(6:8): ',TRIM(cdday) ) 
     1074      ! 
     1075      ishift = ( ijul  ) * 86400 
     1076      !  
     1077      ksec_week = nsec_week + ishift 
     1078      ksec_week = MOD( ksec_week , 86400*7 ) 
     1079      if(lwp)write(numout,*)'cbr ijul ksec_week ',ijul,ksec_week 
     1080      !  
     1081   END FUNCTION ksec_week 
     1082 
    10631083END MODULE fldread 

  • branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r2071 r2075  
    162162 
    163163         DO ifpr= 1, jpfld 
    164             ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 
    165             ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
     164            ALLOCATE( sf(ifpr)%fnow(jpi,jpj) ) 
     165            ALLOCATE( sf(ifpr)%fdta(jpi,jpj,2) ) 
    166166         END DO 
    167167 
    … …  
    178178      ! 
    179179#if defined key_lim3       
    180       tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)     !RB ugly patch 
     180      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:)     !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,1) 
    275             vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
     274            utau(ji,jj) = sf(jp_utau)%fnow(ji,jj) 
     275            vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj) 
    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,1) 
     299            wndm(ji,jj) = sf(jp_wndm)%fnow(ji,jj) 
    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,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) 
     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) 
    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,1) * zes        ! vapour pressure   
     327            zev    = sf(jp_humi)%fnow(ji,jj) * 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,1) * sf(jp_ccov)%fnow(ji,jj,1)     
     335            zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj) * sf(jp_ccov)%fnow(ji,jj)     
    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,1) * sf(jp_wndm)%fnow(ji,jj,1) * ztvmoy, zeps ) 
     353            zdenum  = MAX( sf(jp_wndm)%fnow(ji,jj) * sf(jp_wndm)%fnow(ji,jj) * 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,1) * sf(jp_wndm)%fnow(ji,jj,1) / grav, zeps ) 
     375            zvatmg         = MAX( 0.032 * 1.5e-3 * sf(jp_wndm)%fnow(ji,jj) * sf(jp_wndm)%fnow(ji,jj) / 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,1) 
     389            zrhova         = zrhoa * sf(jp_wndm)%fnow(ji,jj) 
    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,1) / rday * tmask(ji,jj,1) 
     410            emp (ji,jj) = zqla(ji,jj) / cevap - sf(jp_prec)%fnow(ji,jj) / 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,1)                ! air temperature in Kelvins  
     532            ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj)                  ! 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,1) * zes                      ! vapour pressure   
     543            zev = sf(jp_humi)%fnow(ji,jj) * 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,1) / rday   &      ! rday = converte mm/day to kg/m2/s 
     553            p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj) / 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,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) 
     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) 
    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,1) * sf(jp_ccov)%fnow(ji,jj,1)     
     586               zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj) * sf(jp_ccov)%fnow(ji,jj)     
    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,1)      ! computation of intermediate values 
     611               zrhova     = zrhoa(ji,jj) * sf(jp_wndm)%fnow(ji,jj)      ! 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(:,:,1) / rday                       ! total precipitation [kg/m2/s] 
     641      p_tpr(:,:)   = sf(jp_prec)%fnow(:,:) / 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,1) - rtt 
     737            ztamr = sf(jp_tair)%fnow(ji,jj) - 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,1) - 35.86  + MAX( 0.e0, zmt3 ) )  ) 
    743             zev(ji,jj) = sf(jp_humi)%fnow(ji,jj,1) * zes * 1.0e-05                   ! vapour pressure   
     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   
    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,1) ) * 0.05 / ( 1.1 * zcmue**1.4 + 0.15 )   &   ! clear sky 
    801                   &       +         sf(jp_ccov)%fnow(ji,jj,1)   * 0.06                                     ! overcast 
     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 
    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,1)   &       ! cloud correction (Reed 1977) 
     816            zcldcor  = MIN(  1.e0, ( 1.e0 - 0.62 * sf(jp_ccov)%fnow(ji,jj)   &       ! 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,1) - rtt            
     867            ztamr = sf(jp_tair)%fnow(ji,jj) - 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,1) - 35.86  + MAX( 0.e0, zmt3 ) )  ) 
    873             zev(ji,jj) = sf(jp_humi)%fnow(ji,jj,1) * zes * 1.0e-05                   ! vapour pressure   
     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   
    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,1) ) * zqsr_ice_cs    & 
    941                      &                                       +         sf(jp_ccov)%fnow(ji,jj,1)   * zqsr_ice_os  ) 
     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  ) 
    942942               END DO 
    943943            END DO 

  • branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r2071 r2075  
    164164         ENDIF 
    165165         DO ifpr= 1, jfld 
    166             ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 
    167             ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
     166            ALLOCATE( sf(ifpr)%fnow(jpi,jpj) ) 
     167            ALLOCATE( sf(ifpr)%fdta(jpi,jpj,2) ) 
    168168         END DO 
    169169         ! 
    … …  
    176176 
    177177#if defined key_lim3 
    178       tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) 
     178      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:) 
    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,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) )  ) 
     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) )  ) 
    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(:,:,1) * tmask(:,:,1)                                 ! Short Wave 
    265 !CDIR COLLAPSE 
    266       zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave 
     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 
    267267                       
    268268      ! ----------------------------------------------------------------------------- ! 
    … …  
    307307      IF( lhftau ) THEN  
    308308!CDIR COLLAPSE 
    309          taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 
     309         taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:) 
    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(:,:,1) ) * wndm(:,:) )   ! Evaporation 
    333 !CDIR COLLAPSE 
    334          zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:)     ! Sensible Heat 
     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 
    335335      ENDIF 
    336336!CDIR COLLAPSE 
    … …  
    355355      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)      ! Downward Non Solar flux 
    356356!CDIR COLLAPSE 
    357       emp (:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) 
     357      emp (:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:) * 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  ,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) 
     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) 
    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,1) - 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   & 
     464               zwndi_t = sf(jp_wndi)%fnow(ji,jj) - 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,1) - 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   & 
     466               zwndj_t = sf(jp_wndj)%fnow(ji,jj) - 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,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) )  ) 
     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) )  ) 
    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,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - pui(ji,jj) ) 
     492                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj) + sf(jp_wndi)%fnow(ji,jj) ) - 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,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - pvi(ji,jj) ) 
     494                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1) + sf(jp_wndj)%fnow(ji,jj) ) - 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,1) * tmask(ji,jj,1) 
     517               p_qsr(ji,jj,jl) = ( 1. - palb(ji,jj,jl) ) * sf(jp_qsr)%fnow(ji,jj) * tmask(ji,jj,1) 
    518518               ! Long  Wave (lw) 
    519                z_qlw(ji,jj,jl) = 0.95 * (  sf(jp_qlw)%fnow(ji,jj,1)       &                          
     519               z_qlw(ji,jj,jl) = 0.95 * (  sf(jp_qlw)%fnow(ji,jj)       &                          
    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,1) ) 
     530               z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj) ) 
    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,1)  ) ) 
     533                  &                    * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj)  ) ) 
    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(:,:,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] 
     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] 
    566566      CALL iom_put( 'snowpre', p_spr )                  ! Snow precipitation  
    567567      ! 

  • branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcflx.F90

    r2071 r2075  
    126126         ENDIF 
    127127         DO ji= 1, jpfld 
    128             ALLOCATE( sf(ji)%fnow(jpi,jpj,1) ) 
    129             ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) ) 
     128            ALLOCATE( sf(ji)%fnow(jpi,jpj) ) 
     129            ALLOCATE( sf(ji)%fdta(jpi,jpj,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,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) 
     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) 
    152152            END DO 
    153153         END DO 

  • branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r2071 r2075  
    8181            CALL ctl_stop( 'sbc_ice_if: unable to allocate sf_ice structure' )   ;   RETURN 
    8282         ENDIF 
    83          ALLOCATE( sf_ice(1)%fnow(jpi,jpj,1) ) 
    84          ALLOCATE( sf_ice(1)%fdta(jpi,jpj,1,2) ) 
     83         ALLOCATE( sf_ice(1)%fnow(jpi,jpj) ) 
     84         ALLOCATE( sf_ice(1)%fdta(jpi,jpj,2) ) 
    8585 
    8686 
    … …  
    107107               ! 
    108108               zt_fzp  = fr_i(ji,jj)                        ! freezing point temperature 
    109                zfr_obs = sf_ice(1)%fnow(ji,jj,1)              ! observed ice cover 
     109               zfr_obs = sf_ice(1)%fnow(ji,jj)              ! 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/sbcrnf.F90

    r2071 r2075  
    7575               CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' )   ;   RETURN 
    7676            ENDIF 
    77             ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1) ) 
    78             ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 
     77            ALLOCATE( sf_rnf(1)%fnow(jpi,jpj) ) 
     78            ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,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,1) = 0.85 * sf_rnf(1)%fnow(ji,jj,1) 
     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) 
    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(:,:,1) ) 
    104             emps(:,:) = emps(:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:,1) ) 
     103            emp (:,:) = emp (:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:) ) 
     104            emps(:,:) = emps(:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:) ) 
    105105            CALL iom_put( "runoffs", sf_rnf(1)%fnow )         ! runoffs 
    106106         ENDIF 

  • branches/devmercator2010/NEMO/OPA_SRC/SBC/sbcssr.F90

    r2071 r2075  
    115115               CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sst structure' )   ;   RETURN 
    116116            ENDIF 
    117             ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1) ) 
    118             ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2) ) 
     117            ALLOCATE( sf_sst(1)%fnow(jpi,jpj) ) 
     118            ALLOCATE( sf_sst(1)%fdta(jpi,jpj,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,1) ) 
    131             ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2) ) 
     130            ALLOCATE( sf_sss(1)%fnow(jpi,jpj) ) 
     131            ALLOCATE( sf_sss(1)%fdta(jpi,jpj,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,1) ) 
     155                     zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj) ) 
    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,1) )   & 
     169                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj) )   & 
    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,1) )   & 
     184                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj) )   & 
    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

    r2071 r2075  
    142142!CDIR NOVERRCHK 
    143143                  DO ji = 1, jpi 
    144                      zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) 
     144                     zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj) ) ) 
    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,1)   ) 
    337                ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) ) 
     336               ALLOCATE( sf_chl(1)%fnow(jpi,jpj)   ) 
     337               ALLOCATE( sf_chl(1)%fdta(jpi,jpj,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

    r2072 r2075  
    196196if [ "${USE_IOSERVER}" = "true" ] 
    197197then 
    198     cp ${MAINDIR}/modipsl/bin/ioserver ioserver 
     198    cp ${WORK}/../bin/ioserver ioserver 
    199199    chmod 777 ioserver 
    200200fi 

  • branches/devmercator2010/NVTK/INSTALL/JOBS/job_ORCA2_LIM3.ksh

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