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

Changeset 1951


Ignore:
Timestamp:
2010-06-24T17:00:16+02:00 (14 years ago)
Author:
acc
Message:

ticket #684 step 2: Add in changes from the DEV_r1784_3DF branch

Location:
branches/DEV_r1784_mid_year_merge_2010
Files:
11 edited

Legend:

Unmodified
Added
Removed

  • branches/DEV_r1784_mid_year_merge_2010/CONFIG/ORCA2_LIM/EXP00/namelist

    r1759 r1951  
    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/DEV_r1784_mid_year_merge_2010/NEMO/OPA_SRC/DTA/dtasal.F90

    r1715 r1951  
    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 ::   & 
    82           il0, il1, ii0, ii1, ij0, ij1   ! temporary integers          
    83 # endif 
    84      REAL(wp) ::   zxy, zl 
    85 #if defined key_orca_lev10 
    86      REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: zsal 
    87      INTEGER   :: ikr, ikw, ikt, jjk 
    88      REAL(wp)  :: zfac 
    89 #endif 
    90      REAL(wp), DIMENSION(jpk,2) ::   & 
    91           zsaldta            ! auxiliary array for interpolation 
    92      !!---------------------------------------------------------------------- 
    93       
    94      ! 0. Initialization 
    95      ! ----------------- 
    96       
    97      iman  = INT( raamo ) 
    98 !!! better but change the results     i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 
    99      i15   = nday / 16 
    100      imois = nmonth + i15 - 1 
    101      IF( imois == 0 ) imois = iman 
    102       
    103      ! 1. First call kt=nit000 
    104      ! ----------------------- 
    105       
    106      IF( kt == nit000 ) THEN 
    107          
    108         nsal1 = 0   ! initializations 
    109         IF(lwp) WRITE(numout,*) ' dta_sal : monthly salinity data in NetCDF file' 
    110         CALL iom_open ( 'data_1m_salinity_nomask', numsdt )  
    111          
    112      ENDIF 
    113       
    114       
    115      ! 2. Read monthly file 
    116      ! ------------------- 
    117       
    118      IF( kt == nit000 .OR. imois /= nsal1 ) THEN 
    119          
    120         ! 2.1 Calendar computation 
    121          
    122         nsal1 = imois        ! first file record used  
    123         nsal2 = nsal1 + 1    ! last  file record used 
    124         nsal1 = MOD( nsal1, iman ) 
    125         IF( nsal1 == 0 ) nsal1 = iman 
    126         nsal2 = MOD( nsal2, iman ) 
    127         IF( nsal2 == 0 ) nsal2 = iman 
    128         IF(lwp) WRITE(numout,*) 'first record file used nsal1 ', nsal1 
    129         IF(lwp) WRITE(numout,*) 'last  record file used nsal2 ', nsal2 
    130          
    131         ! 2.3 Read monthly salinity data Levitus  
    132          
    133 #if defined key_orca_lev10 
    134         if (ln_zps) stop 
    135         zsal(:,:,:,:) = 0. 
    136         CALL iom_get (numsdt,jpdom_data,'vosaline',zsal(:,:,:,1),nsal1) 
    137         CALL iom_get (numsdt,jpdom_data,'vosaline',zsal(:,:,:,2),nsal2) 
     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      INTEGER ::   ji, jj, jk, jl, jkk            ! dummy loop indicies 
     71      INTEGER ::   imois, iman, i15 , ik          ! temporary integers 
     72      INTEGER ::   ierror 
     73#if defined key_tradmp 
     74      INTEGER ::   il0, il1, ii0, ii1, ij0, ij1   ! temporary integers 
     75#endif 
     76      REAL(wp)::   zxy, zl 
     77#if defined key_orca_lev10 
     78      INTEGER ::   ikr, ikw, ikt, jjk  
     79      REAL(wp)::   zfac 
     80#endif 
     81      REAL(wp), DIMENSION(jpk) ::   zsaldta            ! auxiliary array for interpolation 
     82      CHARACTER(len=100)       :: cn_dir          ! Root directory for location of ssr files 
     83      TYPE(FLD_N)              :: sn_sal 
     84      LOGICAL , SAVE           :: linit_sal = .FALSE. 
     85      !!---------------------------------------------------------------------- 
     86      NAMELIST/namdta_sal/cn_dir,sn_sal 
     87      
     88      ! 1. Initialization 
     89      ! ----------------------- 
     90      
     91      IF( kt == nit000 .AND. ( .NOT. linit_sal ) ) THEN 
     92         
     93         !                         ! set file information 
     94         cn_dir = './'             ! directory in which the model is executed 
     95         ! ... default values (NB: frequency positive => hours, negative => months) 
     96         !            !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
     97         !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
     98         sn_sal = FLD_N( 'salinity',  -1.  ,  'vosaline',  .false.   , .true.  ,  'monthly'  , ''       , ''         ) 
     99 
     100         REWIND ( numnam )         ! ... read in namlist namdta_sal  
     101         READ( numnam, namdta_sal )  
     102 
     103         IF(lwp) THEN              ! control print 
     104            WRITE(numout,*) 
     105            WRITE(numout,*) 'dta_sal : Salinity Climatology ' 
     106            WRITE(numout,*) '~~~~~~~ ' 
     107         ENDIF 
     108         ALLOCATE( sf_sal(1), STAT=ierror ) 
     109         IF( ierror > 0 ) THEN 
     110             CALL ctl_stop( 'dta_sal: unable to allocate sf_sal structure' )   ;   RETURN 
     111         ENDIF 
     112#if defined key_orca_lev10 
     113         ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpkdta  ) ) 
     114         ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpkdta,2) ) 
    138115#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          
     116         ALLOCATE( sf_sal(1)%fnow(jpi,jpj,jpk  ) ) 
     117         ALLOCATE( sf_sal(1)%fdta(jpi,jpj,jpk,2) ) 
     118#endif 
     119 
     120         ! fill sf_sal with sn_sal and control print 
     121         CALL fld_fill( sf_sal, (/ sn_sal /), cn_dir, 'dta_sal', 'Salinity data', 'namdta_sal' ) 
     122         linit_sal = .TRUE.         
     123      ENDIF 
     124      
     125      
     126      ! 2. Read monthly file 
     127      ! ------------------- 
     128      
     129      CALL fld_read( kt, 1, sf_sal ) 
     130 
     131      IF( lwp .AND. kt==nn_it000 ) THEN 
     132         WRITE(numout,*) 
     133         WRITE(numout,*) ' read Levitus salinity ok' 
     134         WRITE(numout,*) 
     135      ENDIF 
     136 
    149137#if defined key_tradmp 
    150         IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN 
     138      IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN 
     139    
     140         !                                        ! ======================= 
     141         !                                        !  ORCA_R2 configuration 
     142         !                                        ! ======================= 
     143         ij0 = 101   ;   ij1 = 109 
     144         ii0 = 141   ;   ii1 = 155    
     145         DO jj = mj0(ij0), mj1(ij1)                  ! Reduced salinity in the Alboran Sea 
     146            DO ji = mi0(ii0), mi1(ii1) 
     147               sf_sal(1)%fnow(ji,jj,13:13) = sf_sal(1)%fnow(ji,jj,13:13) - 0.15 
     148               sf_sal(1)%fnow(ji,jj,14:15) = sf_sal(1)%fnow(ji,jj,14:15) - 0.25 
     149               sf_sal(1)%fnow(ji,jj,16:17) = sf_sal(1)%fnow(ji,jj,16:17) - 0.30 
     150               sf_sal(1)%fnow(ji,jj,18:25) = sf_sal(1)%fnow(ji,jj,18:25) - 0.35 
     151            END DO 
     152         END DO 
     153 
     154         IF( n_cla == 1 ) THEN  
     155            !                                         ! New salinity profile at Gibraltar 
     156            il0 = 138   ;   il1 = 138    
     157            ij0 = 101   ;   ij1 = 102 
     158            ii0 = 139   ;   ii1 = 139    
     159            DO jl = mi0(il0), mi1(il1) 
     160               DO jj = mj0(ij0), mj1(ij1) 
     161                  DO ji = mi0(ii0), mi1(ii1) 
     162                        sf_sal(1)%fnow(ji,jj,:) = sf_sal(1)%fnow(jl,jj,:) 
     163                  END DO 
     164               END DO 
     165            END DO 
     166            !                                         ! New salinity profile at Bab el Mandeb 
     167            il0 = 164   ;   il1 = 164    
     168            ij0 =  87   ;   ij1 =  88 
     169            ii0 = 161   ;   ii1 = 163    
     170            DO jl = mi0(il0), mi1(il1) 
     171               DO jj = mj0(ij0), mj1(ij1) 
     172                  DO ji = mi0(ii0), mi1(ii1) 
     173                     sf_sal(1)%fnow(ji,jj,:) = sf_sal(1)%fnow(jl,jj,:) 
     174                  END DO 
     175               END DO 
     176            END DO 
     177            ! 
     178         ENDIF 
     179            ! 
     180      ENDIF 
     181#endif    
     182         
     183#if defined key_orca_lev10 
     184      DO jjk = 1, 5 
     185         s_dta(:,:,jjk) = sf_sal(1)%fnow(:,:,1) 
     186      ENDDO 
     187      DO jk = 1, jpk-20,10 
     188         ikr =  INT(jk/10) + 1 
     189         ikw =  (ikr-1) *10 + 1 
     190         ikt =  ikw + 5 
     191         DO jjk=ikt,ikt+9 
     192            zfac = ( gdept_0(jjk   ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 
     193            s_dta(:,:,jjk) = sf_sal(1)%fnow(:,:,ikr) + ( sf_sal(1)%fnow(:,:,ikr+1) - sf_sal(1)%fnow(:,:,ikr) ) * zfac 
     194         END DO 
     195      END DO 
     196      DO jjk = jpk-5, jpk 
     197         s_dta(:,:,jjk) = sf_sal(1)%fnow(:,:,jpkdta-1) 
     198      END DO 
     199      ! fill the overlap areas 
     200      CALL lbc_lnk (s_dta(:,:,:),'Z',-999.,'no0')         
     201#else 
     202      s_dta(:,:,:)=sf_sal(1)%fnow(:,:,:) 
     203#endif 
     204         
     205      IF( ln_sco ) THEN 
     206         DO jj = 1, jpj                  ! interpolation of salinites 
     207            DO ji = 1, jpi 
     208               DO jk = 1, jpk 
     209                  zl=fsdept_0(ji,jj,jk) 
     210                  IF(zl < gdept_0(1)  ) zsaldta(jk) =  s_dta(ji,jj,1    )  
     211                  IF(zl > gdept_0(jpk)) zsaldta(jk) =  s_dta(ji,jj,jpkm1)  
     212                  DO jkk = 1, jpkm1 
     213                     IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 
     214                          zsaldta(jk) = s_dta(ji,jj,jkk)                                 & 
     215                                     &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))      & 
     216                                     &                              *(s_dta(ji,jj,jkk+1) - s_dta(ji,jj,jkk)) 
     217                     ENDIF 
     218                  END DO 
     219               END DO 
     220               DO jk = 1, jpkm1 
     221                  s_dta(ji,jj,jk) = zsaldta(jk)  
     222               END DO 
     223               s_dta(ji,jj,jpk) = 0.0  
     224            END DO 
     225         END DO 
    151226            
    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) 
     227         IF( lwp .AND. kt==nn_it000 ) THEN 
     228            WRITE(numout,*) 
     229            WRITE(numout,*) ' Levitus salinity data interpolated to s-coordinate' 
     230            WRITE(numout,*) 
     231         ENDIF 
     232 
     233      ELSE 
     234         !                                  ! Mask 
     235         s_dta(:,:,:) = s_dta(:,:,:) * tmask(:,:,:) 
     236         s_dta(:,:,jpk) = 0.  
     237         IF( ln_zps ) THEN               ! z-coord. partial steps 
     238            DO jj = 1, jpj               ! interpolation of salinity at the last ocean level (i.e. the partial step) 
     239               DO ji = 1, jpi 
     240                  ik = mbathy(ji,jj) - 1 
     241                  IF( ik > 2 ) THEN 
     242                     zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 
     243                     s_dta(ji,jj,ik) = (1.-zl) * s_dta(ji,jj,ik) + zl * s_dta(ji,jj,ik-1) 
     244                  ENDIF 
     245               END DO 
     246            END DO 
     247         ENDIF 
     248      ENDIF 
     249         
     250      IF( lwp .AND. kt==nn_it000 ) THEN 
     251         WRITE(numout,*)' salinity Levitus ' 
     252         WRITE(numout,*) 
     253         WRITE(numout,*)'  level = 1' 
     254         CALL prihre(s_dta(:,:,1),    jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
     255         WRITE(numout,*)'  level = ',jpk/2 
     256         CALL prihre(s_dta(:,:,jpk/2),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)            
     257         WRITE(numout,*) '  level = ',jpkm1 
     258         CALL prihre(s_dta(:,:,jpkm1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
     259      ENDIF 
    305260 
    306261   END SUBROUTINE dta_sal 

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

    r1715 r1951  
    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 
    83       INTEGER ::   & 
    84          imois, iman, i15 , ik      ! temporary integers 
    85 #  if defined key_tradmp 
    86       INTEGER ::   & 
    87          il0, il1, ii0, ii1, ij0, ij1   ! temporary integers 
    88 # endif 
    89       REAL(wp) ::   zxy, zl 
    90 #if defined key_orca_lev10 
    91       REAL(wp), DIMENSION(jpi,jpj,jpkdta,2) :: ztem 
    92       INTEGER   :: ikr, ikw, ikt, jjk  
    93       REAL(wp)  :: zfac 
    94 #endif 
    95       REAL(wp), DIMENSION(jpk,2) ::   & 
    96          ztemdta            ! auxiliary array for interpolation 
     75      INTEGER ::   ji, jj, jk, jl, jkk            ! dummy loop indicies 
     76      INTEGER ::   imois, iman, i15 , ik          ! temporary integers 
     77      INTEGER ::   ierror 
     78#if defined key_tradmp 
     79      INTEGER ::   il0, il1, ii0, ii1, ij0, ij1   ! temporary integers 
     80#endif 
     81      REAL(wp)::   zxy, zl 
     82#if defined key_orca_lev10 
     83      INTEGER ::   ikr, ikw, ikt, jjk  
     84      REAL(wp)::   zfac 
     85#endif 
     86      REAL(wp), DIMENSION(jpk) ::   ztemdta            ! auxiliary array for interpolation 
     87      CHARACTER(len=100)       ::   cn_dir             ! Root directory for location of ssr files 
     88      TYPE(FLD_N)              ::   sn_tem 
     89      LOGICAL , SAVE           ::   linit_tem = .FALSE. 
    9790      !!---------------------------------------------------------------------- 
    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 
     91      NAMELIST/namdta_tem/cn_dir,sn_tem 
     92  
     93      ! 1. Initialization  
    10994      ! ----------------------- 
    11095       
    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        
     96      IF( kt == nit000 .AND. (.NOT. linit_tem ) ) THEN 
     97 
     98         !                   ! set file information 
     99         cn_dir = './'       ! directory in which the model is executed 
     100         ! ... default values (NB: frequency positive => hours, negative => months) 
     101         !            !   file    ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
     102         !            !   name    !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
     103         sn_tem = FLD_N( 'temperature',  -1.  ,  'votemper',  .false.   , .true.  ,  'yearly'  , ''       , ''         ) 
     104 
     105         REWIND( numnam )            ! ... read in namlist namdta_tem  
     106         READ( numnam, namdta_tem )  
     107 
     108         IF(lwp) THEN                ! control print 
     109            WRITE(numout,*) 
     110            WRITE(numout,*) 'dta_tem : Temperature Climatology ' 
     111            WRITE(numout,*) '~~~~~~~ ' 
     112         ENDIF 
     113         ALLOCATE( sf_tem(1), STAT=ierror ) 
     114         IF( ierror > 0 ) THEN 
     115             CALL ctl_stop( 'dta_tem: unable to allocate sf_tem structure' )   ;   RETURN 
     116         ENDIF 
     117 
     118#if defined key_orca_lev10 
     119         ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpkdta  ) ) 
     120         ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpkdta,2) ) 
     121#else 
     122         ALLOCATE( sf_tem(1)%fnow(jpi,jpj,jpk  ) ) 
     123         ALLOCATE( sf_tem(1)%fdta(jpi,jpj,jpk,2) ) 
     124#endif 
     125         ! fill sf_tem with sn_tem and control print 
     126         CALL fld_fill( sf_tem, (/ sn_tem /), cn_dir, 'dta_tem', 'Temperature data', 'namdta_tem' ) 
     127         linit_tem = .TRUE. 
     128 
     129      ENDIF 
    119130       
    120131      ! 2. Read monthly file 
    121132      ! ------------------- 
    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,*) 
     133          
     134      CALL fld_read( kt, 1, sf_tem ) 
     135        
     136      IF( lwp .AND. kt==nn_it000 )THEN  
     137         WRITE(numout,*) 
     138         WRITE(numout,*) ' read Levitus temperature ok' 
     139         WRITE(numout,*) 
     140      ENDIF 
    151141          
    152142#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 
     143      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN 
     144             
     145         !                                        ! ======================= 
     146         !                                        !  ORCA_R2 configuration 
     147         !                                        ! =======================  
     148         ij0 = 101   ;   ij1 = 109 
     149         ii0 = 141   ;   ii1 = 155 
     150         DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea 
     151            DO ji = mi0(ii0), mi1(ii1) 
     152               sf_tem(1)%fnow(ji,jj, 13:13 ) = sf_tem(1)%fnow(ji,jj, 13:13 ) - 0.20 
     153               sf_tem(1)%fnow(ji,jj, 14:15 ) = sf_tem(1)%fnow(ji,jj, 14:15 ) - 0.35   
     154               sf_tem(1)%fnow(ji,jj, 16:25 ) = sf_tem(1)%fnow(ji,jj, 16:25 ) - 0.40 
     155            END DO 
     156         END DO 
     157             
     158         IF( n_cla == 1 ) THEN  
     159            !                                         ! New temperature 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_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:) 
     167                  END DO 
     168               END DO 
     169            END DO 
     170            !                                         ! New temperature 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_tem(1)%fnow(ji,jj,:) = sf_tem(1)%fnow(jl,jj,:) 
     178                  END DO 
     179               END DO 
     180            END DO 
     181            ! 
     182         ELSE 
     183            !                                         ! Reduced temperature at Red Sea 
     184            ij0 =  87   ;   ij1 =  96 
     185            ii0 = 148   ;   ii1 = 160 
     186            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0 
     187            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5 
     188            sf_tem(1)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 ) = 6.0 
     189         ENDIF 
     190            ! 
     191      ENDIF 
     192#endif 
     193          
     194#if defined key_orca_lev10 
     195      DO jjk = 1, 5 
     196         t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,1) 
     197      END DO 
     198      DO jk = 1, jpk-20,10 
     199         ik = jk+5 
     200         ikr =  INT(jk/10) + 1 
     201         ikw =  (ikr-1) *10 + 1 
     202         ikt =  ikw + 5 
     203         DO jjk=ikt,ikt+9 
     204            zfac = ( gdept_0(jjk   ) - gdepw_0(ikt) ) / ( gdepw_0(ikt+10) - gdepw_0(ikt) ) 
     205            t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,ikr) + ( sf_tem(1)%fnow(:,:,ikr+1) - sf_tem(1)%fnow(:,:,ikr) ) * zfac 
     206         END DO 
     207      END DO 
     208      DO jjk = jpk-5, jpk 
     209         t_dta(:,:,jjk) = sf_tem(1)%fnow(:,:,jpkdta-1) 
     210      END DO 
     211      ! fill the overlap areas 
     212      CALL lbc_lnk (t_dta(:,:,:),'Z',-999.,'no0') 
    166213#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 
     214      t_dta(:,:,:) = sf_tem(1)%fnow(:,:,:)  
     215#endif 
     216          
     217      IF( ln_sco ) THEN 
     218         DO jj = 1, jpj                  ! interpolation of temperatures 
     219            DO ji = 1, jpi 
     220               DO jk = 1, jpk 
     221                  zl=fsdept_0(ji,jj,jk) 
     222                  IF(zl < gdept_0(1))   ztemdta(jk) =  t_dta(ji,jj,1) 
     223                  IF(zl > gdept_0(jpk)) ztemdta(jk) =  t_dta(ji,jj,jpkm1)  
     224                  DO jkk = 1, jpkm1 
     225                     IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 
     226                        ztemdta(jk) = t_dta(ji,jj,jkk)                                 & 
     227                                  &    + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))  & 
     228                                  &    * (t_dta(ji,jj,jkk+1) - t_dta(ji,jj,jkk)) 
     229                     ENDIF 
    188230                  END DO 
    189231               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 
     232               DO jk = 1, jpkm1 
     233                  t_dta(ji,jj,jk) = ztemdta(jk) 
     234               END DO 
     235               t_dta(ji,jj,jpk) = 0.0 
     236            END DO 
     237         END DO 
     238             
     239         IF( lwp .AND. kt==nn_it000 )THEN 
    299240            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 
     241            WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate' 
     242            WRITE(numout,*) 
     243         ENDIF 
     244             
     245      ELSE 
     246         !                                  ! Mask 
     247         t_dta(:,:,:  ) = t_dta(:,:,:) * tmask(:,:,:) 
     248         t_dta(:,:,jpk) = 0. 
     249         IF( ln_zps ) THEN                ! z-coord. with partial steps 
     250            DO jj = 1, jpj                ! interpolation of temperature at the last level 
     251               DO ji = 1, jpi 
     252                  ik = mbathy(ji,jj) - 1 
     253                  IF( ik > 2 ) THEN 
     254                     zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 
     255                     t_dta(ji,jj,ik) = (1.-zl) * t_dta(ji,jj,ik) + zl * t_dta(ji,jj,ik-1) 
     256                  ENDIF 
     257            END DO 
     258         END DO 
     259      ENDIF 
     260 
     261   ENDIF 
     262          
     263   IF( lwp .AND. kt==nn_it000 ) THEN 
     264      WRITE(numout,*) ' temperature Levitus ' 
     265      WRITE(numout,*) 
     266      WRITE(numout,*)'  level = 1' 
     267      CALL prihre( t_dta(:,:,1    ), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     268      WRITE(numout,*)'  level = ', jpk/2 
     269      CALL prihre( t_dta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     270      WRITE(numout,*)'  level = ', jpkm1 
     271      CALL prihre( t_dta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     272   ENDIF 
     273 
     274   END SUBROUTINE dta_tem 
    322275 
    323276#else 

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

    r1730 r1951  
    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 
    … …  
    120120 
    121121      INTEGER  ::   jf         ! dummy indices 
     122      INTEGER  ::   jk         ! dummy indices 
     123      INTEGER  ::   ipk        ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    122124      INTEGER  ::   kw         ! index into wgts array 
    123125      INTEGER  ::   ireclast   ! last record to be read in the current year file 
    … …  
    143145            IF( sd(jf)%ln_tint ) THEN         ! time interpolation: swap before record field 
    144146!CDIR COLLAPSE 
    145                sd(jf)%fdta(:,:,1) = sd(jf)%fdta(:,:,2) 
    146                sd(jf)%rotn(1)     = sd(jf)%rotn(2) 
     147               sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) 
     148               sd(jf)%rotn(1)       = sd(jf)%rotn(2) 
    147149            ENDIF 
    148150 
    … …  
    202204 
    203205            ! read after data 
     206            ipk = SIZE( sd(jf)%fdta, 3 ) 
    204207            IF( LEN(TRIM(sd(jf)%wgtname)) > 0 ) THEN 
    205208               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) ) 
     209               DO jk = 1, ipk 
     210                  CALL fld_interp( sd(jf)%num, sd(jf)%clvar, kw, sd(jf)%fdta(:,:,jk,2), sd(jf)%nrec_a(1) ) 
     211               END DO 
    207212            ELSE 
    208                CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) ) 
     213               IF( ipk == 1 ) THEN  
     214                  CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,1,2), sd(jf)%nrec_a(1) ) 
     215               ELSE 
     216                  CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,:,2), sd(jf)%nrec_a(1) ) 
     217               ENDIF 
    209218            ENDIF 
    210219            sd(jf)%rotn(2) = .FALSE. 
    … …  
    245254                         utmp(:,:) = 0.0 
    246255                         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(:,:) 
     256                         ! 
     257                         DO jk = 1, SIZE( sd(kf)%fdta, 3 ) 
     258                            CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->i', utmp(:,:) ) 
     259                            CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->j', vtmp(:,:) ) 
     260                            sd(jf)%fdta(:,:,jk,nf) = utmp(:,:) 
     261                            sd(kf)%fdta(:,:,jk,nf) = vtmp(:,:) 
     262                         END DO 
     263                         ! 
    251264                         sd(jf)%rotn(nf) = .TRUE. 
    252265                         sd(kf)%rotn(nf) = .TRUE. 
    … …  
    280293               ztintb =  1. - ztinta 
    281294!CDIR COLLAPSE 
    282                sd(jf)%fnow(:,:) = ztintb * sd(jf)%fdta(:,:,1) + ztinta * sd(jf)%fdta(:,:,2) 
     295               sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2) 
    283296            ELSE 
    284297               IF(lwp .AND. kt - nit000 <= 100 ) THEN 
    … …  
    288301               ENDIF 
    289302!CDIR COLLAPSE 
    290                sd(jf)%fnow(:,:) = sd(jf)%fdta(:,:,2)   ! piecewise constant field 
     303               sd(jf)%fnow(:,:,:) = sd(jf)%fdta(:,:,:,2)   ! piecewise constant field 
    291304  
    292305            ENDIF 
    … …  
    320333      INTEGER :: inrec          ! number of record existing for this variable 
    321334      INTEGER :: kwgt 
     335      INTEGER :: jk             ! vertical loop variable 
     336      INTEGER :: ipk            ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    322337      CHARACTER(LEN=1000) ::   clfmt   ! write format 
    323338      !!--------------------------------------------------------------------- 
    … …  
    339354               IF( sdjf%cltype == 'monthly' ) THEN   ! monthly file 
    340355                  sdjf%nrec_b(1) = 1                                                       ! force to read the unique record 
    341                   llprevmth = .NOT. sdjf%ln_clim                                           ! use previous month file? 
     356                  llprevmth = .TRUE.                                                       ! use previous month file? 
    342357                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file? 
    343358               ELSE                                  ! yearly file 
    … …  
    384399 
    385400         ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read 
     401         ipk = SIZE( sdjf%fdta, 3 ) 
    386402         IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
    387403            CALL wgt_list( sdjf, kwgt ) 
    388             CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, sdjf%fdta(:,:,2), sdjf%nrec_b(1) ) 
     404            DO jk = 1, ipk 
     405               CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, sdjf%fdta(:,:,jk,2), sdjf%nrec_b(1) ) 
     406            END DO 
    389407         ELSE 
    390             CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,2), sdjf%nrec_b(1) ) 
     408            IF( ipk == 1 ) THEN 
     409               CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_b(1) ) 
     410            ELSE 
     411               CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_b(1) ) 
     412            ENDIF 
    391413         ENDIF 
    392414         sdjf%rotn(2) = .FALSE. 
    … …  
    534556         IF( sdjf%cltype /= 'yearly' )    WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname     ), kmonth   ! add month 
    535557         IF( sdjf%cltype == 'daily'  )    WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname     ), kday     ! add day 
     558      ELSE 
     559         ! build the new filename if climatological data 
     560         IF( sdjf%cltype == 'monthly' )   WRITE(sdjf%clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month 
    536561      ENDIF 
    537562      CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 ) 
    … …  
    564589         sdf(jf)%ln_tint    = sdf_n(jf)%ln_tint 
    565590         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 
     591         sdf(jf)%cltype     = sdf_n(jf)%cltype 
    569592         sdf(jf)%wgtname = " " 
    570593         IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 )   sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname ) 

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

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

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

    r1730 r1951  
    164164         ENDIF 
    165165         DO ifpr= 1, jfld 
    166             ALLOCATE( sf(ifpr)%fnow(jpi,jpj) ) 
    167             ALLOCATE( sf(ifpr)%fdta(jpi,jpj,2) ) 
     166            ALLOCATE( sf(ifpr)%fnow(jpi,jpj,1  ) ) 
     167            ALLOCATE( sf(ifpr)%fdta(jpi,jpj,1,2) ) 
    168168         END DO 
    169169         ! 
    … …  
    176176 
    177177#if defined key_lim3 
    178       tatm_ice(:,:) = sf(jp_tair)%fnow(:,:) 
     178      tatm_ice(:,:) = sf(jp_tair)%fnow(:,:,1) 
    179179#endif 
    180180 
    … …  
    244244      DO jj = 2, jpjm1 
    245245         DO ji = fs_2, fs_jpim1   ! vect. opt. 
    246             zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj) - 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  ) 
    247             zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj) - 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  ) 
     246            zwnd_i(ji,jj) = (  sf(jp_wndi)%fnow(ji,jj,1) - 0.5 * ( pu(ji-1,jj  ) + pu(ji,jj) )  ) 
     247            zwnd_j(ji,jj) = (  sf(jp_wndj)%fnow(ji,jj,1) - 0.5 * ( pv(ji  ,jj-1) + pv(ji,jj) )  ) 
    248248         END DO 
    249249      END DO 
    … …  
    262262      ! ocean albedo assumed to be 0.066 
    263263!CDIR COLLAPSE 
    264       qsr (:,:) = ( 1. - 0.066 ) * sf(jp_qsr)%fnow(:,:) * tmask(:,:,1)                                 ! Short Wave 
    265 !CDIR COLLAPSE 
    266       zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave 
     264      qsr (:,:) = ( 1. - 0.066 ) * sf(jp_qsr)%fnow(:,:,1) * tmask(:,:,1)                                     ! Short Wave 
     265!CDIR COLLAPSE 
     266      zqlw(:,:) = (  sf(jp_qlw)%fnow(:,:,1) - Stef * zst(:,:)*zst(:,:)*zst(:,:)*zst(:,:)  ) * tmask(:,:,1)   ! Long  Wave 
    267267                       
    268268      ! ----------------------------------------------------------------------------- ! 
    … …  
    307307      IF( lhftau ) THEN  
    308308!CDIR COLLAPSE 
    309          taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:) 
     309         taum(:,:) = taum(:,:) + sf(jp_tdif)%fnow(:,:,1) 
    310310      ENDIF 
    311311      CALL iom_put( "taum_oce", taum )   ! output wind stress module 
    … …  
    330330      ELSE 
    331331!CDIR COLLAPSE 
    332          zevap(:,:) = MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:) ) * wndm(:,:) )   ! Evaporation 
    333 !CDIR COLLAPSE 
    334          zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:) ) * wndm(:,:)     ! Sensible Heat 
     332         zevap(:,:) = MAX( 0.e0, rhoa    *Ce(:,:)*( zqsatw(:,:) - sf(jp_humi)%fnow(:,:,1) ) * wndm(:,:) )   ! Evaporation 
     333!CDIR COLLAPSE 
     334         zqsb (:,:) =            rhoa*cpa*Ch(:,:)*( zst   (:,:) - sf(jp_tair)%fnow(:,:,1) ) * wndm(:,:)     ! Sensible Heat 
    335335      ENDIF 
    336336!CDIR COLLAPSE 
    … …  
    355355      qns(:,:) = zqlw(:,:) - zqsb(:,:) - zqla(:,:)      ! Downward Non Solar flux 
    356356!CDIR COLLAPSE 
    357       emp (:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:) * rn_pfac * tmask(:,:,1) 
     357      emp (:,:) = zevap(:,:) - sf(jp_prec)%fnow(:,:,1) * rn_pfac * tmask(:,:,1) 
    358358!CDIR COLLAPSE 
    359359      emps(:,:) = emp(:,:) 
    … …  
    453453            DO ji = 2, jpim1   ! B grid : no vector opt 
    454454               ! ... scalar wind at I-point (fld being at T-point) 
    455                zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ) + sf(jp_wndi)%fnow(ji  ,jj  )   & 
    456                   &              + sf(jp_wndi)%fnow(ji-1,jj-1) + sf(jp_wndi)%fnow(ji  ,jj-1)  ) - pui(ji,jj) 
    457                zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ) + sf(jp_wndj)%fnow(ji  ,jj  )   & 
    458                   &              + sf(jp_wndj)%fnow(ji-1,jj-1) + sf(jp_wndj)%fnow(ji  ,jj-1)  ) - pvi(ji,jj) 
     455               zwndi_f = 0.25 * (  sf(jp_wndi)%fnow(ji-1,jj  ,1) + sf(jp_wndi)%fnow(ji  ,jj  ,1)   & 
     456                  &              + sf(jp_wndi)%fnow(ji-1,jj-1,1) + sf(jp_wndi)%fnow(ji  ,jj-1,1)  ) - pui(ji,jj) 
     457               zwndj_f = 0.25 * (  sf(jp_wndj)%fnow(ji-1,jj  ,1) + sf(jp_wndj)%fnow(ji  ,jj  ,1)   & 
     458                  &              + sf(jp_wndj)%fnow(ji-1,jj-1,1) + sf(jp_wndj)%fnow(ji  ,jj-1,1)  ) - pvi(ji,jj) 
    459459               zwnorm_f = zcoef_wnorm * SQRT( zwndi_f * zwndi_f + zwndj_f * zwndj_f ) 
    460460               ! ... ice stress at I-point 
    … …  
    462462               p_tauj(ji,jj) = zwnorm_f * zwndj_f 
    463463               ! ... scalar wind at T-point (fld being at T-point) 
    464                zwndi_t = sf(jp_wndi)%fnow(ji,jj) - 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   & 
    465                   &                                        + 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)   & 
    467                   &                                        + pvi(ji,jj  ) + pvi(ji+1,jj  )  ) 
     464               zwndi_t = sf(jp_wndi)%fnow(ji,jj,1) - 0.25 * (  pui(ji,jj+1) + pui(ji+1,jj+1)   & 
     465                  &                                          + pui(ji,jj  ) + pui(ji+1,jj  )  ) 
     466               zwndj_t = sf(jp_wndj)%fnow(ji,jj,1) - 0.25 * (  pvi(ji,jj+1) + pvi(ji+1,jj+1)   & 
     467                  &                                          + 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) 
    469469            END DO 
    … …  
    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 
    … …  
    489489         DO jj = 2, jpjm1 
    490490            DO ji = fs_2, fs_jpim1   ! vect. opt. 
    491                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) ) 
    493                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) ) 
     491               p_taui(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji+1,jj  ) + z_wnds_t(ji,jj) )                          & 
     492                  &          * ( 0.5 * (sf(jp_wndi)%fnow(ji+1,jj,1) + sf(jp_wndi)%fnow(ji,jj,1) ) - pui(ji,jj) ) 
     493               p_tauj(ji,jj) = zcoef_wnorm2 * ( z_wnds_t(ji,jj+1  ) + z_wnds_t(ji,jj) )                          & 
     494                  &          * ( 0.5 * (sf(jp_wndj)%fnow(ji,jj+1,1) + sf(jp_wndj)%fnow(ji,jj,1) ) - pvi(ji,jj) ) 
    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)       &                          
    520                   &                   - Stef * pst(ji,jj,jl) * zst3  ) * tmask(ji,jj,1) 
     519               z_qlw(ji,jj,jl) = 0.95 * (  sf(jp_qlw)%fnow(ji,jj,1) - Stef * pst(ji,jj,jl) * zst3  ) * tmask(ji,jj,1) 
    521520               ! lw sensitivity 
    522521               z_dqlw(ji,jj,jl) = zcoef_dqlw * zst3                                                
    … …  
    528527               ! ... turbulent heat fluxes 
    529528               ! 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) ) 
     529               z_qsb(ji,jj,jl) = rhoa * cpa * Cice * z_wnds_t(ji,jj) * ( pst(ji,jj,jl) - sf(jp_tair)%fnow(ji,jj,1) ) 
    531530               ! Latent Heat 
    532531               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)  ) ) 
     532                  &                    * (  11637800. * EXP( -5897.8 / pst(ji,jj,jl) ) / rhoa - sf(jp_humi)%fnow(ji,jj,1)  ) ) 
    534533               ! Latent heat sensitivity for ice (Dqla/Dt) 
    535534               p_dqla(ji,jj,jl) = zcoef_dqla * z_wnds_t(ji,jj) / ( zst2 ) * EXP( -5897.8 / pst(ji,jj,jl) ) 
    … …  
    561560        
    562561!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] 
     562      p_tpr(:,:) = sf(jp_prec)%fnow(:,:,1) * rn_pfac      ! total precipitation [kg/m2/s] 
     563!CDIR COLLAPSE 
     564      p_spr(:,:) = sf(jp_snow)%fnow(:,:,1) * rn_pfac      ! solid precipitation [kg/m2/s] 
    566565      CALL iom_put( 'snowpre', p_spr )                  ! Snow precipitation  
    567566      ! 

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

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

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

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

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

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

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

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

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

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