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

Changeset 2130


Ignore:
Timestamp:
2010-09-29T16:48:12+02:00 (14 years ago)
Author:
cbricaud
Message:

Add chnages from DEV_r1784_3DF branch

Location:
branches/devmercator2010_1
Files:
13 edited

Legend:

Unmodified
Added
Removed

  • branches/devmercator2010_1/CONFIG/ORCA2_LIM/EXP00/namelist

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

  • branches/devmercator2010_1/CONFIG/ORCA2_LIM_PISCES/EXP00/namelist

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

  • branches/devmercator2010_1/NEMO/OPA_SRC/DIA/diawri.F90

    r1756 r2130  
    3030   USE limwri_2  
    3131#endif 
     32   USE dtatem 
     33   USE dtasal 
     34 
    3235   IMPLICIT NONE 
    3336   PRIVATE 
    … …  
    489492 
    490493      ! Write fields on T grid 
    491       CALL histwrite( nid_T, "votemper", it, tn            , ndim_T , ndex_T  )   ! temperature 
    492       CALL histwrite( nid_T, "vosaline", it, sn            , ndim_T , ndex_T  )   ! salinity 
     494      CALL histwrite( nid_T, "votemper", it, t_dta            , ndim_T , ndex_T  )   ! temperature 
     495      CALL histwrite( nid_T, "vosaline", it, s_dta            , ndim_T , ndex_T  )   ! salinity 
    493496      CALL histwrite( nid_T, "sosstsst", it, tn(:,:,1)     , ndim_hT, ndex_hT )   ! sea surface temperature 
    494497      CALL histwrite( nid_T, "sosaline", it, sn(:,:,1)     , ndim_hT, ndex_hT )   ! sea surface salinity 

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

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

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

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

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

    r1730 r2130  
    4848      INTEGER , DIMENSION(2)          ::   nrec_b       ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year) 
    4949      INTEGER , DIMENSION(2)          ::   nrec_a       ! after  record (1: index, 2: second since Jan. 1st 00h of nit000 year) 
    50       REAL(wp) , ALLOCATABLE, DIMENSION(:,:)   ::   fnow         ! input fields interpolated to now time step 
    51       REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:) ::   fdta         ! 2 consecutive record of input fields 
     50      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:)   ::   fnow       ! input fields interpolated to now time step 
     51      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta       ! 2 consecutive record of input fields 
    5252      CHARACTER(len = 256)            ::   wgtname      ! current name of the NetCDF weight file acting as a key 
    5353                                                        ! into the WGTLIST structure 
    … …  
    7878      INTEGER, DIMENSION(:,:,:), POINTER      ::   data_jpj     ! array of source integers 
    7979      REAL(wp), DIMENSION(:,:,:), POINTER     ::   data_wgt     ! array of weights on model grid 
    80       REAL(wp), DIMENSION(:,:), POINTER       ::   fly_dta      ! array of values on input grid 
    81       REAL(wp), DIMENSION(:,:), POINTER       ::   col2         ! temporary array for reading in columns 
     80      REAL(wp), DIMENSION(:,:,:), POINTER       ::   fly_dta      ! array of values on input grid 
     81      REAL(wp), DIMENSION(:,:,:), POINTER       ::   col2         ! temporary array for reading in columns 
    8282   END TYPE WGT 
    8383 
    … …  
    120120 
    121121      INTEGER  ::   jf         ! dummy indices 
     122      INTEGER  ::   jk         ! dummy indices 
     123      INTEGER  ::   ipk        ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    122124      INTEGER  ::   kw         ! index into wgts array 
    123125      INTEGER  ::   ireclast   ! last record to be read in the current year file 
    … …  
    143145            IF( sd(jf)%ln_tint ) THEN         ! time interpolation: swap before record field 
    144146!CDIR COLLAPSE 
    145                sd(jf)%fdta(:,:,1) = sd(jf)%fdta(:,:,2) 
     147               sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) 
    146148               sd(jf)%rotn(1)     = sd(jf)%rotn(2) 
    147149            ENDIF 
    … …  
    157159 
    158160               ! last record to be read in the current file 
    159                IF( sd(jf)%nfreqh == -1 ) THEN                  ;   ireclast = 12 
     161               IF( sd(jf)%nfreqh == -1 ) THEN 
     162                  IF(     sd(jf)%cltype == 'monthly'   ) THEN  ;   ireclast = 1 
     163                  ELSE                                         ;   ireclast = 12 
     164                  ENDIF 
    160165               ELSE                              
    161166                  IF(     sd(jf)%cltype == 'monthly'   ) THEN  ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh  
    … …  
    204209            IF( LEN(TRIM(sd(jf)%wgtname)) > 0 ) THEN 
    205210               CALL wgt_list( sd(jf), kw ) 
    206                CALL fld_interp( sd(jf)%num, sd(jf)%clvar, kw, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) ) 
     211               ipk = SIZE(sd(jf)%fnow,3) 
     212               IF( sd(jf)%ln_tint ) THEN 
     213                  CALL fld_interp( sd(jf)%num, sd(jf)%clvar , kw , ipk, sd(jf)%fdta(:,:,:,2) , sd(jf)%nrec_a(1) ) 
     214               ELSE 
     215                  CALL fld_interp( sd(jf)%num, sd(jf)%clvar , kw , ipk, sd(jf)%fnow(:,:,:)   , sd(jf)%nrec_a(1) ) 
     216               ENDIF 
    207217            ELSE 
    208                CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) ) 
     218               SELECT CASE( SIZE(sd(jf)%fnow,3) ) 
     219               CASE(1)    
     220                  IF( sd(jf)%ln_tint ) THEN 
     221                     CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,1,2), sd(jf)%nrec_a(1) ) 
     222                  ELSE 
     223                     CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fnow(:,:,1)  , sd(jf)%nrec_a(1) ) 
     224                  ENDIF  
     225               CASE(jpk) 
     226                  IF( sd(jf)%ln_tint ) THEN 
     227                     CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,:,2), sd(jf)%nrec_a(1) ) 
     228                  ELSE 
     229                     CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fnow(:,:,:)  , sd(jf)%nrec_a(1) ) 
     230                  ENDIF  
     231               END SELECT 
    209232            ENDIF 
    210233            sd(jf)%rotn(2) = .FALSE. 
    … …  
    240263                IF( kf > 0 ) THEN 
    241264                   !! fields jf,kf are two components which need to be rotated together 
    242                    DO nf = 1,2 
     265                   IF( sd(jf)%ln_tint )THEN 
     266                      DO nf = 1,2 
     267                         !! check each time level of this pair 
     268                         IF( .NOT. sd(jf)%rotn(nf) .AND. .NOT. sd(kf)%rotn(nf) ) THEN 
     269                            utmp(:,:) = 0.0 
     270                            vtmp(:,:) = 0.0 
     271                            ! 
     272                            ipk = SIZE( sd(kf)%fnow(:,:,:) ,3 ) 
     273                            DO jk = 1,ipk 
     274                               CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->i', utmp(:,:) ) 
     275                               CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->j', vtmp(:,:) ) 
     276                               sd(jf)%fdta(:,:,jk,nf) = utmp(:,:) 
     277                               sd(kf)%fdta(:,:,jk,nf) = vtmp(:,:) 
     278                            ENDDO 
     279                            ! 
     280                            sd(jf)%rotn(nf) = .TRUE. 
     281                            sd(kf)%rotn(nf) = .TRUE. 
     282                            IF( lwp .AND. kt == nit000 ) & 
     283                                      WRITE(numout,*) 'fld_read: vector pair (',  & 
     284                                                      TRIM(sd(jf)%clvar),',',TRIM(sd(kf)%clvar), & 
     285                                                      ') rotated on to model grid' 
     286                         ENDIF 
     287                      END DO 
     288                   ELSE  
    243289                      !! check each time level of this pair 
    244290                      IF( .NOT. sd(jf)%rotn(nf) .AND. .NOT. sd(kf)%rotn(nf) ) THEN 
    245291                         utmp(:,:) = 0.0 
    246292                         vtmp(:,:) = 0.0 
    247                          CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->i', utmp(:,:) ) 
    248                          CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->j', vtmp(:,:) ) 
    249                          sd(jf)%fdta(:,:,nf) = utmp(:,:) 
    250                          sd(kf)%fdta(:,:,nf) = vtmp(:,:) 
     293                         ! 
     294                         ipk = SIZE( sd(kf)%fnow(:,:,:) ,3 ) 
     295                         DO jk = 1,ipk 
     296                            CALL rot_rep( sd(jf)%fnow(:,:,jk),sd(kf)%fnow(:,:,jk),'T', 'en->i', utmp(:,:) ) 
     297                            CALL rot_rep( sd(jf)%fnow(:,:,jk),sd(kf)%fnow(:,:,jk),'T', 'en->j', vtmp(:,:) ) 
     298                            sd(jf)%fnow(:,:,jk) = utmp(:,:) 
     299                            sd(kf)%fnow(:,:,jk) = vtmp(:,:) 
     300                         ENDDO 
     301                         ! 
    251302                         sd(jf)%rotn(nf) = .TRUE. 
    252303                         sd(kf)%rotn(nf) = .TRUE. 
    … …  
    256307                                                   ') rotated on to model grid' 
    257308                      ENDIF 
    258                    END DO 
     309                   ENDIF 
    259310                ENDIF 
    260311             ENDIF 
    … …  
    280331               ztintb =  1. - ztinta 
    281332!CDIR COLLAPSE 
    282                sd(jf)%fnow(:,:) = ztintb * sd(jf)%fdta(:,:,1) + ztinta * sd(jf)%fdta(:,:,2) 
     333               sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2) 
    283334            ELSE 
    284335               IF(lwp .AND. kt - nit000 <= 100 ) THEN 
    … …  
    288339               ENDIF 
    289340!CDIR COLLAPSE 
    290                sd(jf)%fnow(:,:) = sd(jf)%fdta(:,:,2)   ! piecewise constant field 
    291   
    292341            ENDIF 
    293342            ! 
    … …  
    320369      INTEGER :: inrec          ! number of record existing for this variable 
    321370      INTEGER :: kwgt 
     371      INTEGER :: jk             !vertical loop variable 
     372      INTEGER :: ipk            !number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    322373      CHARACTER(LEN=1000) ::   clfmt   ! write format 
    323374      !!--------------------------------------------------------------------- 
    … …  
    339390               IF( sdjf%cltype == 'monthly' ) THEN   ! monthly file 
    340391                  sdjf%nrec_b(1) = 1                                                       ! force to read the unique record 
    341                   llprevmth = .NOT. sdjf%ln_clim                                           ! use previous month file? 
     392                  llprevmth = .TRUE.                                                       ! use previous month file? 
    342393                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file? 
    343394               ELSE                                  ! yearly file 
    … …  
    366417            &                  nmonth - COUNT((/llprevmth/)) + 12                   * COUNT((/llprevyr /)),               & 
    367418            &                  nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)), .NOT. llprev ) 
    368           
     419 
    369420         ! if previous year/month/day file does not exist, we switch to the current year/month/day 
    370421         IF( llprev .AND. sdjf%num == 0 ) THEN 
    … …  
    384435 
    385436         ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read 
     437          
    386438         IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
    387439            CALL wgt_list( sdjf, kwgt ) 
    388             CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, sdjf%fdta(:,:,2), sdjf%nrec_b(1) ) 
     440            ipk = SIZE(sdjf%fnow,3) 
     441            IF( sdjf%ln_tint ) THEN 
     442               CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, ipk, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 
     443            ELSE 
     444               CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, ipk, sdjf%fnow(:,:,:)  , sdjf%nrec_a(1) ) 
     445            ENDIF 
    389446         ELSE 
    390             CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,2), sdjf%nrec_b(1) ) 
     447            write(narea+200,*)' sdjf%ln_tint SIZE(sdjf%fnow,3) ',sdjf%ln_tint,SIZE(sdjf%fnow,3) ; call flush(narea+200) 
     448            write(narea+200,*)' SIZE(sdjf%fdta,3)  SIZE(sdjf%fdta,4) ',SIZE(sdjf%fdta,3),SIZE(sdjf%fdta,4)  ; call flush(narea+200) 
     449            SELECT CASE( SIZE(sdjf%fnow,3) ) 
     450            CASE(1) 
     451               IF( sdjf%ln_tint ) THEN 
     452                  CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_b(1) ) 
     453               ELSE 
     454                  CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,1)  , sdjf%nrec_b(1) ) 
     455               ENDIF 
     456            CASE(jpk) 
     457               IF( sdjf%ln_tint ) THEN 
     458                  CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_b(1) ) 
     459               ELSE 
     460                  CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fnow(:,:,:)  , sdjf%nrec_b(1) ) 
     461               ENDIF 
     462            END SELECT 
     463            write(narea+200,*)' test1 ok ' ; call flush(narea+200) 
    391464         ENDIF 
    392465         sdjf%rotn(2) = .FALSE. 
    … …  
    399472      ENDIF 
    400473 
     474 
    401475      IF( sdjf%num == 0 )   CALL fld_clopn( sdjf, nyear, nmonth, nday )   ! make sure current year/month/day file is opened 
    402476 
    403477      sdjf%nswap_sec = nsec_year + nsec1jan000 - 1   ! force read/update the after data in the following part of fld_read  
    404        
     478      
    405479   END SUBROUTINE fld_init 
    406480 
    … …  
    436510            !       forcing record :  nmonth  
    437511            !                             
    438             ztmp  = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 
     512            ztmp  = 0.e0 
     513            IF(  REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) .GT. 0.5 ) ztmp  = 1.0 
    439514         ELSE 
    440515            ztmp  = 0.e0 
    … …  
    446521         ENDIF 
    447522 
    448          sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define after  record number and time 
    449          irec = irec - 1                                                ! move back to previous record 
    450          sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define before record number and time 
     523         IF( sdjf%cltype == 'monthly' ) THEN 
     524 
     525            sdjf%nrec_b(:) = (/ 0, nmonth_half(irec - 1 ) + nsec1jan000 /) 
     526            sdjf%nrec_a(:) = (/ 1, nmonth_half(irec     ) + nsec1jan000 /) 
     527 
     528            IF( ztmp  == 1. ) THEN 
     529              sdjf%nrec_b(1) = 1 
     530              sdjf%nrec_a(1) = 2 
     531            ENDIF 
     532 
     533         ELSE 
     534 
     535            sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define after  record number and time 
     536            irec = irec - 1                                                ! move back to previous record 
     537            sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define before record number and time 
     538 
     539         ENDIF 
    451540         ! 
    452541      ELSE                              ! higher frequency mean (in hours) 
    … …  
    534623         IF( sdjf%cltype /= 'yearly' )    WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname     ), kmonth   ! add month 
    535624         IF( sdjf%cltype == 'daily'  )    WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname     ), kday     ! add day 
     625      ELSE 
     626         ! build the new filename if climatological data 
     627         IF( sdjf%cltype == 'monthly' )   WRITE(sdjf%clname, '(a,"_m" ,i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month 
    536628      ENDIF 
    537629      CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 ) 
    … …  
    564656         sdf(jf)%ln_tint    = sdf_n(jf)%ln_tint 
    565657         sdf(jf)%ln_clim    = sdf_n(jf)%ln_clim 
    566          IF( sdf(jf)%nfreqh == -1. ) THEN   ;   sdf(jf)%cltype = 'yearly' 
    567          ELSE                               ;   sdf(jf)%cltype = sdf_n(jf)%cltype 
    568          ENDIF 
     658         sdf(jf)%cltype     = sdf_n(jf)%cltype 
    569659         sdf(jf)%wgtname = " " 
    570660         IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 )   sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname ) 
    … …  
    587677               &                          ' pairing    : '    , TRIM( sdf(jf)%vcomp      ),   & 
    588678               &                          ' data type: '      ,       sdf(jf)%cltype 
     679            call flush(numout) 
    589680         END DO 
    590681      ENDIF 
    … …  
    684775      INTEGER                                 ::   inum          ! temporary logical unit 
    685776      INTEGER                                 ::   id            ! temporary variable id 
     777      INTEGER                                 ::   ipk           ! temporary vertical dimension 
    686778      CHARACTER (len=5)                       ::   aname 
    687779      INTEGER , DIMENSION(3)                  ::   ddims 
    … …  
    848940         ! SA: +3 stencil is a patch to avoid out-of-bound computation in some configuration.  
    849941         ! a more robust solution will be given in next release 
    850          ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3) ) 
    851          IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col2(2,ref_wgts(nxt_wgt)%jpjwgt+3) ) 
     942         ipk =  SIZE(sd%fnow,3) 
     943         ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3 ,ipk) ) 
     944         IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col2(2,ref_wgts(nxt_wgt)%jpjwgt+3,ipk) ) 
    852945 
    853946         nxt_wgt = nxt_wgt + 1 
    … …  
    859952   END SUBROUTINE fld_weight 
    860953 
    861    SUBROUTINE fld_interp(num, clvar, kw, dta, nrec) 
     954   SUBROUTINE fld_interp(num, clvar, kw, kk, dta, nrec) 
    862955      !!--------------------------------------------------------------------- 
    863956      !!                    ***  ROUTINE fld_interp  *** 
    … …  
    871964      CHARACTER(LEN=*), INTENT(in)                        ::   clvar               ! variable name 
    872965      INTEGER,          INTENT(in)                        ::   kw                  ! weights number 
    873       REAL(wp),         INTENT(inout), DIMENSION(jpi,jpj) ::   dta                 ! output field on model grid 
     966      INTEGER,          INTENT(in)                        ::   kk                  ! vertical dimension of kk 
     967      REAL(wp),         INTENT(inout), DIMENSION(jpi,jpj,kk) ::   dta              ! output field on model grid 
    874968      INTEGER,          INTENT(in)                        ::   nrec                ! record number to read (ie time slice) 
    875969      !!  
    876       INTEGER, DIMENSION(2)                               ::   rec1,recn           ! temporary arrays for start and length 
     970      INTEGER, DIMENSION(3)                               ::   rec1,recn           ! temporary arrays for start and length 
    877971      INTEGER                                             ::  jk, jn, jm           ! loop counters 
    878972      INTEGER                                             ::  ni, nj               ! lengths 
    … …  
    897991      rec1(1) = MAX( jpimin-1, 1 ) 
    898992      rec1(2) = MAX( jpjmin-1, 1 ) 
     993      rec1(3) = 1 
    899994      recn(1) = MIN( jpiwid+2, ref_wgts(kw)%ddims(1)-rec1(1)+1 ) 
    900995      recn(2) = MIN( jpjwid+2, ref_wgts(kw)%ddims(2)-rec1(2)+1 ) 
     996      recn(3) = kk 
    901997 
    902998      !! where we need to read it to 
    … …  
    9061002      jpj2 = jpj1 + recn(2) - 1 
    9071003 
    908       ref_wgts(kw)%fly_dta(:,:) = 0.0 
    909       CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2), nrec, rec1, recn) 
     1004      ref_wgts(kw)%fly_dta(:,:,:) = 0.0 
     1005      SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) ) 
     1006      CASE(1) 
     1007           CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn) 
     1008      CASE(jpk)   
     1009           CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn) 
     1010      END SELECT  
    9101011 
    9111012      !! first four weights common to both bilinear and bicubic 
    9121013      !! note that we have to offset by 1 into fly_dta array because of halo 
    913       dta(:,:) = 0.0 
     1014      dta(:,:,:) = 0.0 
    9141015      DO jk = 1,4 
    915         DO jn = 1, jpj 
    916           DO jm = 1,jpi 
     1016        DO jn = 1, nlcj 
     1017          DO jm = 1,nlci 
    9171018            ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    9181019            nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    919             dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1) 
     1020            dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1,jk) 
    9201021          END DO 
    9211022        END DO 
    … …  
    9261027        !! fix up halo points that we couldnt read from file 
    9271028        IF( jpi1 == 2 ) THEN 
    928            ref_wgts(kw)%fly_dta(jpi1-1,:) = ref_wgts(kw)%fly_dta(jpi1,:) 
     1029           ref_wgts(kw)%fly_dta(jpi1-1,:,:) = ref_wgts(kw)%fly_dta(jpi1,:,:) 
    9291030        ENDIF 
    9301031        IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 
    931            ref_wgts(kw)%fly_dta(jpi2+1,:) = ref_wgts(kw)%fly_dta(jpi2,:) 
     1032           ref_wgts(kw)%fly_dta(jpi2+1,:,:) = ref_wgts(kw)%fly_dta(jpi2,:,:) 
    9321033        ENDIF 
    9331034        IF( jpj1 == 2 ) THEN 
    934            ref_wgts(kw)%fly_dta(:,jpj1-1) = ref_wgts(kw)%fly_dta(:,jpj1) 
     1035           ref_wgts(kw)%fly_dta(:,jpj1-1,:) = ref_wgts(kw)%fly_dta(:,jpj1,:) 
    9351036        ENDIF 
    9361037        IF( jpj2 + jpjmin - 1 == ref_wgts(kw)%ddims(2)+1 .AND. jpj2 .lt. jpjwid+2 ) THEN 
    937            ref_wgts(kw)%fly_dta(:,jpj2+1) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2) - ref_wgts(kw)%fly_dta(:,jpj2-1) 
     1038           ref_wgts(kw)%fly_dta(:,jpj2+1,:) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2,:) - ref_wgts(kw)%fly_dta(:,jpj2-1,:) 
    9381039        ENDIF 
    9391040 
    … …  
    9481049           IF( jpi1 == 2 ) THEN 
    9491050              rec1(1) = ref_wgts(kw)%ddims(1) - 1 
    950               CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn) 
    951               ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2) = ref_wgts(kw)%col2(ref_wgts(kw)%offset+1,jpj1:jpj2) 
     1051              SELECT CASE( SIZE( ref_wgts(kw)%col2(:,jpj1:jpj2,:),3) ) 
     1052              CASE(1) 
     1053                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,1), nrec, rec1, recn) 
     1054              CASE(jpk)          
     1055                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,:), nrec, rec1, recn) 
     1056              END SELECT       
     1057              ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col2(ref_wgts(kw)%offset+1,jpj1:jpj2,:) 
    9521058           ENDIF 
    9531059           IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 
    9541060              rec1(1) = 1 
    955               CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn) 
    956               ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2) = ref_wgts(kw)%col2(2-ref_wgts(kw)%offset,jpj1:jpj2) 
     1061              SELECT CASE( SIZE( ref_wgts(kw)%col2(:,jpj1:jpj2,:),3) ) 
     1062              CASE(1) 
     1063                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,1), nrec, rec1, recn) 
     1064              CASE(jpk) 
     1065                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,:), nrec, rec1, recn) 
     1066              END SELECT 
     1067              ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col2(2-ref_wgts(kw)%offset,jpj1:jpj2,:) 
    9571068           ENDIF 
    9581069        ENDIF 
    … …  
    9601071        ! gradient in the i direction 
    9611072        DO jk = 1,4 
    962           DO jn = 1, jpj 
    963             DO jm = 1,jpi 
     1073          DO jn = 1, nlcj 
     1074            DO jm = 1,nlci 
    9641075              ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    9651076              nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    966               dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 *         & 
    967                                (ref_wgts(kw)%fly_dta(ni+2,nj+1) - ref_wgts(kw)%fly_dta(ni,nj+1)) 
     1077              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 *         & 
     1078                               (ref_wgts(kw)%fly_dta(ni+2,nj+1,:) - ref_wgts(kw)%fly_dta(ni,nj+1,:)) 
    9681079            END DO 
    9691080          END DO 
    … …  
    9721083        ! gradient in the j direction 
    9731084        DO jk = 1,4 
    974           DO jn = 1, jpj 
    975             DO jm = 1,jpi 
     1085          DO jn = 1, nlcj 
     1086            DO jm = 1,nlci 
    9761087              ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    9771088              nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    978               dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 *         & 
    979                                (ref_wgts(kw)%fly_dta(ni+1,nj+2) - ref_wgts(kw)%fly_dta(ni+1,nj)) 
     1089              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 *         & 
     1090                               (ref_wgts(kw)%fly_dta(ni+1,nj+2,:) - ref_wgts(kw)%fly_dta(ni+1,nj,:)) 
    9801091            END DO 
    9811092          END DO 
    … …  
    9881099              ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    9891100              nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    990               dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( & 
    991                                (ref_wgts(kw)%fly_dta(ni+2,nj+2) - ref_wgts(kw)%fly_dta(ni  ,nj+2)) -   & 
    992                                (ref_wgts(kw)%fly_dta(ni+2,nj  ) - ref_wgts(kw)%fly_dta(ni  ,nj  ))) 
     1101              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( & 
     1102                               (ref_wgts(kw)%fly_dta(ni+2,nj+2,:) - ref_wgts(kw)%fly_dta(ni  ,nj+2,:)) -   & 
     1103                               (ref_wgts(kw)%fly_dta(ni+2,nj  ,:) - ref_wgts(kw)%fly_dta(ni  ,nj  ,:))) 
    9931104            END DO 
    9941105          END DO 

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

    r1732 r2130  
    129129         &                          sn_ccov, sn_tair, sn_prec 
    130130      !!--------------------------------------------------------------------- 
     131      write(narea+200,*)'clio : '; call flush(narea+200) 
    131132 
    132133      !                                         ! ====================== ! 
    … …  
    160161            CALL ctl_stop( 'sbc_blk_clio: unable to allocate sf structure' )   ;   RETURN 
    161162         ENDIF 
    162  
    163163         DO ifpr= 1, jpfld 
    164             ALLOCATE( sf(ifpr)%fnow(jpi,jpj) ) 
    165             ALLOCATE( sf(ifpr)%fdta(jpi,jpj,2) ) 
    166          END DO 
    167  
    168  
     164            ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1) ) 
     165            IF( slf_i(ifpr)%ln_tint ) ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
     166         END DO 
    169167         ! fill sf with slf_i and control print 
    170168         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_clio', 'flux formulation for ocean surface boundary condition', 'namsbc_clio' ) 
    … …  
    178176      ! 
    179177#if defined key_lim3       
    180       tatm_ice(:,:) = sf(jp_tair)%fnow(:,:)     !RB ugly patch 
     178      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1)     !RB ugly patch 
    181179#endif 
    182180      ! 
    … …  
    272270      DO jj = 1 , jpj 
    273271         DO ji = 1, jpi 
    274             utau(ji,jj) = sf(jp_utau)%fnow(ji,jj) 
    275             vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj) 
     272            utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
     273            vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
    276274         END DO 
    277275      END DO 
    … …  
    297295      DO jj = 1 , jpj 
    298296         DO ji = 1, jpi 
    299             wndm(ji,jj) = sf(jp_wndm)%fnow(ji,jj) 
     297            wndm(ji,jj) = sf(jp_wndm)%fnow(ji,jj,1) 
    300298         END DO 
    301299      END DO 
    … …  
    317315            ! 
    318316            zsst  = pst(ji,jj)              + rt0           ! converte Celcius to Kelvin the SST 
    319             ztatm = sf(jp_tair)%fnow(ji,jj)                 ! and set minimum value far above 0 K (=rt0 over land) 
    320             zcco1 = 1.0 - sf(jp_ccov)%fnow(ji,jj)           ! fraction of clear sky ( 1 - cloud cover) 
     317            ztatm = sf(jp_tair)%fnow(ji,jj,1)               ! and set minimum value far above 0 K (=rt0 over land) 
     318            zcco1 = 1.0 - sf(jp_ccov)%fnow(ji,jj,1)         ! fraction of clear sky ( 1 - cloud cover) 
    321319            zrhoa = zpatm / ( 287.04 * ztatm )              ! air density (equation of state for dry air)  
    322320            ztamr = ztatm - rtt                             ! Saturation water vapour 
    … …  
    325323            zmt3  = SIGN( 28.200, -ztamr )                  !           \/ 
    326324            zes   = 611.0 * EXP(  ABS( ztamr ) * MIN ( zmt1, zmt2 ) / ( ztatm - 35.86  + MAX( 0.e0, zmt3 ) )  ) 
    327             zev    = sf(jp_humi)%fnow(ji,jj) * zes          ! vapour pressure   
     325            zev    = sf(jp_humi)%fnow(ji,jj,1) * zes        ! vapour pressure   
    328326            zevsqr = SQRT( zev * 0.01 )                     ! square-root of vapour pressure 
    329327            zqatm = 0.622 * zev / ( zpatm - 0.378 * zev )   ! specific humidity  
    … …  
    333331            !--------------------------------------! 
    334332            ztatm3  = ztatm * ztatm * ztatm 
    335             zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj) * sf(jp_ccov)%fnow(ji,jj)     
     333            zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj,1) * sf(jp_ccov)%fnow(ji,jj,1)     
    336334            ztaevbk = ztatm * ztatm3 * zcldeff * ( 0.39 - 0.05 * zevsqr )  
    337335            ! 
    … …  
    351349            zdeltaq = zqatm - zqsato 
    352350            ztvmoy  = ztatm * ( 1. + 2.2e-3 * ztatm * zqatm ) 
    353             zdenum  = MAX( sf(jp_wndm)%fnow(ji,jj) * sf(jp_wndm)%fnow(ji,jj) * ztvmoy, zeps ) 
     351            zdenum  = MAX( sf(jp_wndm)%fnow(ji,jj,1) * sf(jp_wndm)%fnow(ji,jj,1) * ztvmoy, zeps ) 
    354352            zdtetar = zdteta / zdenum 
    355353            ztvmoyr = ztvmoy * ztvmoy * zdeltaq / zdenum 
    … …  
    373371            zpsil   = zpsih 
    374372             
    375             zvatmg         = MAX( 0.032 * 1.5e-3 * sf(jp_wndm)%fnow(ji,jj) * sf(jp_wndm)%fnow(ji,jj) / grav, zeps ) 
     373            zvatmg         = MAX( 0.032 * 1.5e-3 * sf(jp_wndm)%fnow(ji,jj,1) * sf(jp_wndm)%fnow(ji,jj,1) / grav, zeps ) 
    376374            zcmn           = vkarmn / LOG ( 10. / zvatmg ) 
    377375            zchn           = 0.0327 * zcmn 
    … …  
    387385            zcleo          = zcln * zclcm  
    388386 
    389             zrhova         = zrhoa * sf(jp_wndm)%fnow(ji,jj) 
     387            zrhova         = zrhoa * sf(jp_wndm)%fnow(ji,jj,1) 
    390388 
    391389            ! sensible heat flux 
    … …  
    408406         DO ji = 1, jpi 
    409407            qns (ji,jj) = zqlw(ji,jj) - zqsb(ji,jj) - zqla(ji,jj)      ! Downward Non Solar flux 
    410             emp (ji,jj) = zqla(ji,jj) / cevap - sf(jp_prec)%fnow(ji,jj) / rday * tmask(ji,jj,1) 
     408            emp (ji,jj) = zqla(ji,jj) / cevap - sf(jp_prec)%fnow(ji,jj,1) / rday * tmask(ji,jj,1) 
    411409         END DO 
    412410      END DO 
    … …  
    530528!CDIR NOVERRCHK 
    531529         DO ji = 1, jpi 
    532             ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj)                  ! air temperature in Kelvins  
     530            ztatm (ji,jj) = sf(jp_tair)%fnow(ji,jj,1)                ! air temperature in Kelvins  
    533531       
    534532            zrhoa(ji,jj) = zpatm / ( 287.04 * ztatm(ji,jj) )         ! air density (equation of state for dry air)  
    … …  
    541539               &                / ( ztatm(ji,jj) - 35.86  + MAX( 0.e0, zmt3 ) )  ) 
    542540 
    543             zev = sf(jp_humi)%fnow(ji,jj) * zes                      ! vapour pressure   
     541            zev = sf(jp_humi)%fnow(ji,jj,1) * zes                      ! vapour pressure   
    544542            zevsqr(ji,jj) = SQRT( zev * 0.01 )                       ! square-root of vapour pressure 
    545543            zqatm(ji,jj) = 0.622 * zev / ( zpatm - 0.378 * zev )     ! specific humidity  
    … …  
    551549            zmt2  = ( 272.0 - ztatm(ji,jj) ) / 38.0   ;   zind2 = MAX( 0.e0, SIGN( 1.e0, zmt2 ) ) 
    552550            zmt3  = ( 281.0 - ztatm(ji,jj) ) / 18.0   ;   zind3 = MAX( 0.e0, SIGN( 1.e0, zmt3 ) ) 
    553             p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj) / rday   &        ! rday = converte mm/day to kg/m2/s 
     551            p_spr(ji,jj) = sf(jp_prec)%fnow(ji,jj,1) / rday   &      ! rday = converte mm/day to kg/m2/s 
    554552               &         * (          zind1      &                   ! solid  (snow) precipitation [kg/m2/s] 
    555553               &            + ( 1.0 - zind1 ) * (          zind2   * ( 0.5 + zmt2 )   & 
    … …  
    561559            ! fraction of qsr_ice which is NOT absorbed in the thin surface layer 
    562560            ! and thus which penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 
    563             p_fr1(ji,jj) = 0.18  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj)  
    564             p_fr2(ji,jj) = 0.82  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj) 
     561            p_fr1(ji,jj) = 0.18  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.35 * sf(jp_ccov)%fnow(ji,jj,1)  
     562            p_fr2(ji,jj) = 0.82  * ( 1.e0 - sf(jp_ccov)%fnow(ji,jj,1) ) + 0.65 * sf(jp_ccov)%fnow(ji,jj,1) 
    565563         END DO 
    566564      END DO 
    … …  
    584582               !-------------------------------------------! 
    585583               ztatm3  = ztatm(ji,jj) * ztatm(ji,jj) * ztatm(ji,jj) 
    586                zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj) * sf(jp_ccov)%fnow(ji,jj)     
     584               zcldeff = 1.0 - sbudyko(ji,jj) * sf(jp_ccov)%fnow(ji,jj,1) * sf(jp_ccov)%fnow(ji,jj,1)     
    587585               ztaevbk = ztatm3 * ztatm(ji,jj) * zcldeff * ( 0.39 - 0.05 * zevsqr(ji,jj) )  
    588586               ! 
    … …  
    609607                
    610608               !  sensible and latent fluxes over ice 
    611                zrhova     = zrhoa(ji,jj) * sf(jp_wndm)%fnow(ji,jj)      ! computation of intermediate values 
     609               zrhova     = zrhoa(ji,jj) * sf(jp_wndm)%fnow(ji,jj,1)      ! computation of intermediate values 
    612610               zrhovaclei = zrhova * zcshi * 2.834e+06 
    613611               zrhovacshi = zrhova * zclei * 1004.0 
    … …  
    639637      p_qns(:,:,:) = z_qlw (:,:,:) - z_qsb (:,:,:) - p_qla (:,:,:)      ! Downward Non Solar flux 
    640638!CDIR COLLAPSE 
    641       p_tpr(:,:)   = sf(jp_prec)%fnow(:,:) / rday                       ! total precipitation [kg/m2/s] 
     639      p_tpr(:,:)   = sf(jp_prec)%fnow(:,:,1) / rday                       ! total precipitation [kg/m2/s] 
    642640      ! 
    643641!!gm : not necessary as all input data are lbc_lnk... 
    … …  
    735733!CDIR NOVERRCHK 
    736734         DO ji = 1, jpi 
    737             ztamr = sf(jp_tair)%fnow(ji,jj) - rtt 
     735            ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt 
    738736            zmt1  = SIGN( 17.269,  ztamr ) 
    739737            zmt2  = SIGN( 21.875,  ztamr ) 
    740738            zmt3  = SIGN( 28.200, -ztamr ) 
    741739            zes = 611.0 * EXP(  ABS( ztamr ) * MIN ( zmt1, zmt2 )   &              ! Saturation water vapour 
    742                &                     / ( sf(jp_tair)%fnow(ji,jj) - 35.86  + MAX( 0.e0, zmt3 ) )  ) 
    743             zev(ji,jj) = sf(jp_humi)%fnow(ji,jj) * zes * 1.0e-05                   ! vapour pressure   
     740               &                     / ( sf(jp_tair)%fnow(ji,jj,1) - 35.86  + MAX( 0.e0, zmt3 ) )  ) 
     741            zev(ji,jj) = sf(jp_humi)%fnow(ji,jj,1) * zes * 1.0e-05                   ! vapour pressure   
    744742         END DO 
    745743      END DO 
    … …  
    798796 
    799797               ! ocean albedo depending on the cloud cover (Payne, 1972) 
    800                za_oce     = ( 1.0 - sf(jp_ccov)%fnow(ji,jj) ) * 0.05 / ( 1.1 * zcmue**1.4 + 0.15 )   &   ! clear sky 
    801                   &       +         sf(jp_ccov)%fnow(ji,jj)   * 0.06                                     ! overcast 
     798               za_oce     = ( 1.0 - sf(jp_ccov)%fnow(ji,jj,1) ) * 0.05 / ( 1.1 * zcmue**1.4 + 0.15 )   &   ! clear sky 
     799                  &       +         sf(jp_ccov)%fnow(ji,jj,1)   * 0.06                                     ! overcast 
    802800 
    803801                  ! solar heat flux absorbed by the ocean (Zillman, 1972) 
    … …  
    814812         DO ji = 1, jpi 
    815813            zlmunoon = ASIN( zps(ji,jj) + zpc(ji,jj) ) / rad                         ! local noon solar altitude 
    816             zcldcor  = MIN(  1.e0, ( 1.e0 - 0.62 * sf(jp_ccov)%fnow(ji,jj)   &       ! cloud correction (Reed 1977) 
     814            zcldcor  = MIN(  1.e0, ( 1.e0 - 0.62 * sf(jp_ccov)%fnow(ji,jj,1)   &       ! cloud correction (Reed 1977) 
    817815               &                          + 0.0019 * zlmunoon )                 ) 
    818816            pqsr_oce(ji,jj) = zcoef1 * zcldcor * pqsr_oce(ji,jj) * tmask(ji,jj,1)   ! and zcoef1: ellipsity 
    … …  
    865863!CDIR NOVERRCHK 
    866864         DO ji = 1, jpi            
    867             ztamr = sf(jp_tair)%fnow(ji,jj) - rtt            
     865            ztamr = sf(jp_tair)%fnow(ji,jj,1) - rtt            
    868866            zmt1  = SIGN( 17.269,  ztamr ) 
    869867            zmt2  = SIGN( 21.875,  ztamr ) 
    870868            zmt3  = SIGN( 28.200, -ztamr ) 
    871869            zes = 611.0 * EXP(  ABS( ztamr ) * MIN ( zmt1, zmt2 )   &              ! Saturation water vapour 
    872                &                     / ( sf(jp_tair)%fnow(ji,jj) - 35.86  + MAX( 0.e0, zmt3 ) )  ) 
    873             zev(ji,jj) = sf(jp_humi)%fnow(ji,jj) * zes * 1.0e-05                   ! vapour pressure   
     870               &                     / ( sf(jp_tair)%fnow(ji,jj,1) - 35.86  + MAX( 0.e0, zmt3 ) )  ) 
     871            zev(ji,jj) = sf(jp_humi)%fnow(ji,jj,1) * zes * 1.0e-05                   ! vapour pressure   
    874872         END DO 
    875873      END DO 
    … …  
    938936                     &        / (  1.0 + 0.139  * stauc(ji,jj) * ( 1.0 - 0.9435 * pa_ice_os(ji,jj,jl) ) )        
    939937              
    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  ) 
     938                  pqsr_ice(ji,jj,jl) = pqsr_ice(ji,jj,jl) + (  ( 1.0 - sf(jp_ccov)%fnow(ji,jj,1) ) * zqsr_ice_cs    & 
     939                     &                                       +         sf(jp_ccov)%fnow(ji,jj,1)   * zqsr_ice_os  ) 
    942940               END DO 
    943941            END DO 

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

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

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

    r1730 r2130  
    126126         ENDIF 
    127127         DO ji= 1, jpfld 
    128             ALLOCATE( sf(ji)%fnow(jpi,jpj) ) 
    129             ALLOCATE( sf(ji)%fdta(jpi,jpj,2) ) 
     128            ALLOCATE( sf(ji)%fnow(jpi,jpj,1) ) 
     129            IF( slf_i(ji)%ln_tint ) ALLOCATE( sf(ji)%fdta(jpi,jpj,1,2) ) 
    130130         END DO 
    131131 
    … …  
    145145         DO jj = 1, jpj 
    146146            DO ji = 1, jpi 
    147                utau(ji,jj) = sf(jp_utau)%fnow(ji,jj) 
    148                vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj) 
    149                qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj) - sf(jp_qsr)%fnow(ji,jj) 
    150                qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj) 
    151                emp (ji,jj) = sf(jp_emp )%fnow(ji,jj) 
     147               utau(ji,jj) = sf(jp_utau)%fnow(ji,jj,1) 
     148               vtau(ji,jj) = sf(jp_vtau)%fnow(ji,jj,1) 
     149               qns (ji,jj) = sf(jp_qtot)%fnow(ji,jj,1) - sf(jp_qsr)%fnow(ji,jj,1) 
     150               qsr (ji,jj) = sf(jp_qsr )%fnow(ji,jj,1) 
     151               emp (ji,jj) = sf(jp_emp )%fnow(ji,jj,1) 
    152152            END DO 
    153153         END DO 

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

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

  • branches/devmercator2010_1/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r1730 r2130  
    7575               CALL ctl_stop( 'sbc_rnf: unable to allocate sf_rnf structure' )   ;   RETURN 
    7676            ENDIF 
    77             ALLOCATE( sf_rnf(1)%fnow(jpi,jpj) ) 
    78             ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,2) ) 
    7977         ENDIF 
    8078         CALL sbc_rnf_init(sf_rnf) 
     79         IF( .NOT. ln_rnf_emp ) THEN 
     80            ALLOCATE( sf_rnf(1)%fnow(jpi,jpj,1) ) 
     81            IF( sf_rnf(1)%ln_tint ) ALLOCATE( sf_rnf(1)%fdta(jpi,jpj,1,2) ) 
     82         ENDIF 
    8183      ENDIF 
    8284 
    … …  
    9395            DO jj = 1, jpj 
    9496               DO ji = 1, jpi 
    95                   IF( gphit(ji,jj) > 40 .AND. gphit(ji,jj) < 65 )   sf_rnf(1)%fnow(ji,jj) = 0.85 * sf_rnf(1)%fnow(ji,jj) 
     97                  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) 
    9698               END DO 
    9799            END DO 
    … …  
    101103 
    102104         IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN 
    103             emp (:,:) = emp (:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:) ) 
    104             emps(:,:) = emps(:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:) ) 
     105            emp (:,:) = emp (:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:,1) ) 
     106            emps(:,:) = emps(:,:) - rn_rfact * ABS( sf_rnf(1)%fnow(:,:,1) ) 
    105107            CALL iom_put( "runoffs", sf_rnf(1)%fnow )         ! runoffs 
    106108         ENDIF 

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

    r1730 r2130  
    115115               CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sst structure' )   ;   RETURN 
    116116            ENDIF 
    117             ALLOCATE( sf_sst(1)%fnow(jpi,jpj) ) 
    118             ALLOCATE( sf_sst(1)%fdta(jpi,jpj,2) ) 
     117            ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1) ) 
    119118            ! 
    120119            ! fill sf_sst with sn_sst and control print 
    121120            CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' ) 
     121            IF( sf_sst(1)%ln_tint ) ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2) ) 
    122122         ENDIF 
    123123         ! 
    … …  
    128128               CALL ctl_stop( 'sbc_ssr: unable to allocate sf_sss structure' )   ;   RETURN 
    129129            ENDIF 
    130             ALLOCATE( sf_sss(1)%fnow(jpi,jpj) ) 
    131             ALLOCATE( sf_sss(1)%fdta(jpi,jpj,2) ) 
     130            ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1) ) 
    132131            ! 
    133132            ! fill sf_sss with sn_sss and control print 
    134133            CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' ) 
     134            IF( sf_sss(1)%ln_tint )ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2) ) 
    135135         ENDIF 
    136136         ! 
    … …  
    153153               DO jj = 1, jpj 
    154154                  DO ji = 1, jpi 
    155                      zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj) ) 
     155                     zqrp = rn_dqdt * ( sst_m(ji,jj) - sf_sst(1)%fnow(ji,jj,1) ) 
    156156                     qns(ji,jj) = qns(ji,jj) + zqrp 
    157157                     qrp(ji,jj) = zqrp 
    … …  
    167167                  DO ji = 1, jpi 
    168168                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    169                         &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj) )   & 
     169                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   & 
    170170                        &        / ( sss_m(ji,jj) + 1.e-20   ) 
    171171                     emps(ji,jj) = emps(ji,jj) + zerp 
    … …  
    182182                  DO ji = 1, jpi                             
    183183                     zerp = zsrp * ( 1. - 2.*rnfmsk(ji,jj) )   &      ! No damping in vicinity of river mouths 
    184                         &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj) )   & 
     184                        &        * ( sss_m(ji,jj) - sf_sss(1)%fnow(ji,jj,1) )   & 
    185185                        &        / ( sss_m(ji,jj) + 1.e-20   ) 
    186186                     IF( ln_sssr_bnd )   zerp = SIGN( 1., zerp ) * MIN( zerp_bnd, ABS(zerp) ) 

  • branches/devmercator2010_1/NEMO/OPA_SRC/TRA/traqsr.F90

    r1756 r2130  
    142142!CDIR NOVERRCHK 
    143143                  DO ji = 1, jpi 
    144                      zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj) ) ) 
     144                     zchl = MIN( 10. , MAX( 0.03, sf_chl(1)%fnow(ji,jj,1) ) ) 
    145145                     irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 
    146146                     zekb(ji,jj) = rkrgb(1,irgb) 
    … …  
    334334                  CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_chl structure' )   ;   RETURN 
    335335               ENDIF 
    336                ALLOCATE( sf_chl(1)%fnow(jpi,jpj)   ) 
    337                ALLOCATE( sf_chl(1)%fdta(jpi,jpj,2) ) 
     336               ALLOCATE( sf_chl(1)%fnow(jpi,jpj,1)   ) 
     337               IF( sn_chl%ln_tint )ALLOCATE( sf_chl(1)%fdta(jpi,jpj,1,2) ) 
    338338               !                                        ! fill sf_chl with sn_chl and control print 
    339339               CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init',   & 
Note: See TracChangeset for help on using the changeset viewer.