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

Changeset 2071


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

add change from DEV_r1784_3DF

Location:
branches/devmercator2010/NEMO/OPA_SRC
Files:
49 edited

Legend:

Unmodified
Added
Removed

  • branches/devmercator2010/NEMO/OPA_SRC/DIA/diaar5.F90

    r1948 r2071  
    175175      thick0(:,:) = 0.e0 
    176176      DO jk = 1, jpkm1 
    177          vol0        = vol0        + SUM( area (:,:) * tmask(:,:,jk) * fse3t_0(:,:,jk) ) 
    178          thick0(:,:) = thick0(:,:) +    tmask_i(:,:) * tmask(:,:,jk) * fse3t_0(:,:,jk) 
    179       END DO 
    180       IF( lk_mpp )   CALL mpp_sum( vol0 ) 
     177         vol0        = vol0        + SUM( area (:,:) * tmask(:,:,jk) ) * e3t_0(jk)  
     178         thick0(:,:) = thick0(:,:) +    tmask_i(:,:) * tmask(:,:,jk)   * e3t_0(jk) 
     179      END DO 
    181180       
    182181      CALL iom_open ( 'data_1m_salinity_nomask', inum ) 

  • branches/devmercator2010/NEMO/OPA_SRC/DIA/diadimg.F90

    r1818 r2071  
    1010   USE dom_oce         ! ocean space and time domain 
    1111   USE in_out_manager  ! I/O manager 
    12    USE daymod          ! calendar 
    1312 
    1413   IMPLICIT NONE 
    … …  
    2221   !!---------------------------------------------------------------------- 
    2322   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
    24    !! $Header$  
     23   !! $Id$  
    2524   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    2625   !!---------------------------------------------------------------------- 
    … …  
    5756    INTEGER :: jk, jn           ! dummy loop indices 
    5857    INTEGER :: irecl4,             &    ! record length in bytes 
    59          &       inum,             &    ! logical unit (set to 14) 
    60          &       irec,             &    ! current record to be written 
    61          &       irecend                ! record number where nclit... are stored 
     58         &       inum,             &    ! logical unit 
     59         &       irec                   ! current record to be written 
    6260    REAL(sp)                    :: zdx,zdy,zspval,zwest,ztimm 
    6361    REAL(sp)                    :: zsouth 
    … …  
    7169    !! * Initialisations 
    7270 
    73     irecl4 = MAX(jpi*jpj*sp , 84+(18+1+jpk)*sp ) 
     71    irecl4 = MAX(jpi*jpj*sp , 84+18*sp + (jpk+8)*jpnij*sp ) 
    7472 
    7573    zspval=0.0_sp    ! special values on land 
    … …  
    103101 
    104102    IF ( ln_dimgnnn  ) THEN 
    105      irecl4 = MAX(jpi*jpj*sp , 84+(18+jpk)*sp + 8*jpnij*sp  ) 
    106103       WRITE(clname,'(a,a,i3.3)') TRIM(cd_name),'.',narea 
    107        CALL ctl_opn(inum, clname,'UNKNOWN','UNFORMATTED','DIRECT',irecl4,numout,lwp) 
     104       CALL ctl_opn( inum, clname, 'REPLACE', 'UNFORMATTED', 'DIRECT', irecl4, numout, lwp ) 
    108105       WRITE(inum,REC=1 ) clver, cd_text, irecl4, & 
    109106            &     jpi,jpj, klev, 1 , 1 ,            & 
    … …  
    130127       ENDIF 
    131128    ELSE 
    132        clver='@!03'           ! dimg string identifier 
    133        ! note that version @!02 is optimized with respect to record length. 
    134        ! The vertical dep variable is reduced to klev instead of klev*jpnij : 
    135        !   this is OK for jpnij < 181 (jpk=46) 
    136        ! for more processors, irecl4 get huge and that's why we switch to '@!03': 
    137        !  In this case we just add an extra integer to the standard dimg structure, 
    138        !  which is a record number where the arrays nlci etc... starts (1 per record) 
    139         
    140129       !! Standard dimgproc (1 file per variable, all procs. write to this file ) 
    141130       !! * Open file 
    142        CALL ctl_opn(inum, cd_name,'UNKNOWN','UNFORMATTED','DIRECT',irecl4,numout,lwp) 
     131       CALL ctl_opn( inum, cd_name, 'REPLACE', 'UNFORMATTED', 'DIRECT', irecl4, numout, lwp ) 
    143132 
    144133       !! * Write header on record #1 
    145        irecend=1 + klev*jpnij  
    146134       IF(lwp) WRITE(inum,REC=1 ) clver, cd_text, irecl4, & 
    147             &     jpi,jpj, klev, 1 , 1 ,            & 
     135            &     jpi,jpj, klev*jpnij, 1 , 1 ,            & 
    148136            &     zwest, zsouth, zdx, zdy, zspval,  & 
    149             &     z4dep(1:klev),       & 
     137            &     (z4dep(1:klev),jn=1,jpnij),       & 
    150138            &     ztimm,                            & 
    151             &     narea, jpnij,jpiglo,jpjglo,jpizoom, jpjzoom, irecend  
    152        IF (lwp ) THEN 
    153          WRITE(inum,REC=irecend + 1 ) nlcit 
    154          WRITE(inum,REC=irecend + 2 ) nlcjt 
    155          WRITE(inum,REC=irecend + 3 ) nldit 
    156          WRITE(inum,REC=irecend + 4 ) nldjt 
    157          WRITE(inum,REC=irecend + 5 ) nleit 
    158          WRITE(inum,REC=irecend + 6 ) nlejt 
    159          WRITE(inum,REC=irecend + 7 ) nimppt 
    160          WRITE(inum,REC=irecend + 8 ) njmppt 
    161        ENDIF 
    162       !   &    ! extension to dimg for mpp output 
    163       !   &     nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt  ! 
     139            &     narea, jpnij,jpiglo,jpjglo,jpizoom, jpjzoom,    &    ! extension to dimg for mpp output 
     140            &     nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt  ! 
    164141 
    165142       !! * Write klev levels 

  • branches/devmercator2010/NEMO/OPA_SRC/DIA/dianam.F90

    r1792 r2071  
    129129  
    130130      cdfnam = TRIM(cexper)//TRIM(clave)//"_"//TRIM(cldate1)//"_"//TRIM(cldate2)//"_"//TRIM(cdsuff) 
    131       IF( .NOT. Agrif_Root() ) cdfnam = TRIM(Agrif_CFixed())//'_'//TRIM(cdfnam) 
     131#if defined key_agrif 
     132      if ( .NOT. Agrif_Root() ) cdfnam = TRIM(Agrif_CFixed())//'_'//TRIM(cdfnam) 
     133#endif     
    132134 
    133135   END SUBROUTINE dia_nam 

  • branches/devmercator2010/NEMO/OPA_SRC/DIA/diaptr.F90

    r1877 r2071  
    362362#endif 
    363363 
     364            ! "Meridional" Stream-Function 
     365            DO jk = 2,jpk  
     366               v_msf_glo(:,jk) = v_msf_glo(:,jk-1) + v_msf_glo(:,jk) 
     367            END DO 
     368            v_msf_glo(:,:) = v_msf_glo(:,:) * zsverdrup 
     369#if defined key_diaeiv 
     370            ! Bolus "Meridional" Stream-Function 
     371            DO jk = 2,jpk 
     372               v_msf_eiv_glo(:,jk) = v_msf_eiv_glo(:,jk-1) + v_msf_eiv_glo(:,jk) 
     373            END DO 
     374            v_msf_eiv_glo(:,:) = v_msf_eiv_glo(:,:) * zsverdrup 
     375            IF ( ln_subbas ) THEN  
     376               DO jk = 2,jpk 
     377                  v_msf_eiv_atl(:,jk) = v_msf_eiv_atl(:,jk-1) + v_msf_eiv_atl(:,jk) 
     378                  v_msf_eiv_pac(:,jk) = v_msf_eiv_pac(:,jk-1) + v_msf_eiv_pac(:,jk) 
     379                  v_msf_eiv_ind(:,jk) = v_msf_eiv_ind(:,jk-1) + v_msf_eiv_ind(:,jk) 
     380                  v_msf_eiv_ipc(:,jk) = v_msf_eiv_ipc(:,jk-1) + v_msf_eiv_ipc(:,jk) 
     381               END DO 
     382            ENDIF 
     383#endif 
     384            ! 
     385            IF( ln_subbas .AND. ln_diaznl ) THEN 
     386               DO jk = 2,jpk  
     387                  v_msf_atl(:,jk) = v_msf_atl(:,jk-1) + v_msf_atl(:,jk) 
     388                  v_msf_pac(:,jk) = v_msf_pac(:,jk-1) + v_msf_pac(:,jk) 
     389                  v_msf_ind(:,jk) = v_msf_ind(:,jk-1) + v_msf_ind(:,jk) 
     390                  v_msf_ipc(:,jk) = v_msf_ipc(:,jk-1) + v_msf_ipc(:,jk) 
     391               END DO 
     392               v_msf_atl(:,:) = v_msf_atl(:,:) * zsverdrup 
     393               v_msf_pac(:,:) = v_msf_pac(:,:) * zsverdrup 
     394               v_msf_ind(:,:) = v_msf_ind(:,:) * zsverdrup 
     395               v_msf_ipc(:,:) = v_msf_ipc(:,:) * zsverdrup 
     396            ENDIF 
     397 
    364398            ! Transports 
    365399            ! T times V on T points (include bolus velocities) 
    … …  
    451485               st_ind(:) = st_ind(:) * zggram 
    452486               st_ipc(:) = st_ipc(:) * zggram 
    453             ENDIF 
    454  
    455             ! "Meridional" Stream-Function 
    456             DO jk = 2,jpk  
    457                v_msf_glo(:,jk) = v_msf_glo(:,jk-1) + v_msf_glo(:,jk) 
    458             END DO 
    459             v_msf_glo(:,:) = v_msf_glo(:,:) * zsverdrup 
    460 #if defined key_diaeiv 
    461             ! Bolus "Meridional" Stream-Function 
    462             DO jk = 2,jpk 
    463                v_msf_eiv_glo(:,jk) = v_msf_eiv_glo(:,jk-1) + v_msf_eiv_glo(:,jk) 
    464             END DO 
    465             v_msf_eiv_glo(:,:) = v_msf_eiv_glo(:,:) * zsverdrup 
    466             IF ( ln_subbas ) THEN  
    467                DO jk = 2,jpk 
    468                   v_msf_eiv_atl(:,jk) = v_msf_eiv_atl(:,jk-1) + v_msf_eiv_atl(:,jk) 
    469                   v_msf_eiv_pac(:,jk) = v_msf_eiv_pac(:,jk-1) + v_msf_eiv_pac(:,jk) 
    470                   v_msf_eiv_ind(:,jk) = v_msf_eiv_ind(:,jk-1) + v_msf_eiv_ind(:,jk) 
    471                   v_msf_eiv_ipc(:,jk) = v_msf_eiv_ipc(:,jk-1) + v_msf_eiv_ipc(:,jk) 
    472                END DO 
    473             ENDIF 
    474 #endif 
    475             ! 
    476             IF( ln_subbas .AND. ln_diaznl ) THEN 
    477                DO jk = 2,jpk  
    478                   v_msf_atl(:,jk) = v_msf_atl(:,jk-1) + v_msf_atl(:,jk) 
    479                   v_msf_pac(:,jk) = v_msf_pac(:,jk-1) + v_msf_pac(:,jk) 
    480                   v_msf_ind(:,jk) = v_msf_ind(:,jk-1) + v_msf_ind(:,jk) 
    481                   v_msf_ipc(:,jk) = v_msf_ipc(:,jk-1) + v_msf_ipc(:,jk) 
    482                END DO 
    483                v_msf_atl(:,:) = v_msf_atl(:,:) * zsverdrup 
    484                v_msf_pac(:,:) = v_msf_pac(:,:) * zsverdrup 
    485                v_msf_ind(:,:) = v_msf_ind(:,:) * zsverdrup 
    486                v_msf_ipc(:,:) = v_msf_ipc(:,:) * zsverdrup 
    487487            ENDIF 
    488488         ENDIF 

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

    r1792 r2071  
    629629      ! Define name, frequency of output and means 
    630630      clname = cdfile_name 
    631       IF( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
     631#if defined key_agrif 
     632      if ( .NOT. Agrif_Root() ) clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
     633#endif 
    632634      zdt  = rdt 
    633635      zsto = rdt 

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

    r1886 r2071  
    219219#else 
    220220   LOGICAL, PUBLIC, PARAMETER ::   lk_agrif = .FALSE.   !: agrif flag 
    221  
    222 CONTAINS 
    223    LOGICAL FUNCTION Agrif_Root() 
    224       Agrif_Root = .TRUE. 
    225    END FUNCTION Agrif_Root 
    226  
    227    CHARACTER(len=3) FUNCTION Agrif_CFixed() 
    228      Agrif_CFixed = '0'  
    229    END FUNCTION Agrif_CFixed 
    230221#endif 
    231222 

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

    r1792 r2071  
    166166      ENDIF 
    167167 
     168#if defined key_agrif 
    168169      IF( Agrif_Root() ) THEN 
    169          SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    170          CASE (  1 )  
    171             CALL ioconf_calendar('gregorian') 
    172             IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year' 
    173          CASE (  0 ) 
    174             CALL ioconf_calendar('noleap') 
    175             IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year' 
    176          CASE ( 30 ) 
    177             CALL ioconf_calendar('360d') 
    178             IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year' 
    179          END SELECT 
    180       ENDIF 
     170#endif 
     171      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
     172      CASE (  1 )  
     173         CALL ioconf_calendar('gregorian') 
     174         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "gregorian", i.e. leap year' 
     175      CASE (  0 ) 
     176         CALL ioconf_calendar('noleap') 
     177         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "noleap", i.e. no leap year' 
     178      CASE ( 30 ) 
     179         CALL ioconf_calendar('360d') 
     180         IF(lwp) WRITE(numout,*) '   The IOIPSL calendar is "360d", i.e. 360 days in a year' 
     181      END SELECT 
     182#if defined key_agrif 
     183      ENDIF 
     184#endif 
    181185 
    182186      REWIND( numnam )             ! Namelist namdom : space & time domain (bathymetry, mesh, timestep) 

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

    r1792 r2071  
    270270          
    271271#if defined key_agrif && defined key_eel_r6 
    272          IF( .NOT. Agrif_Root() ) THEN 
     272         IF (.Not.Agrif_Root()) THEN 
    273273           glam0  = Agrif_Parent(glam0) + (Agrif_ix())*Agrif_Parent(ppe1_m) * 1.e-3 
    274274           gphi0  = Agrif_Parent(gphi0) + (Agrif_iy())*Agrif_Parent(ppe2_m) * 1.e-3 
    … …  
    465465          
    466466#if defined key_agrif && defined key_eel_r6 
    467          IF( .NOT. Agrif_Root() ) THEN 
     467         IF (.Not.Agrif_Root()) THEN 
    468468           zphi0 = ppgphi0 - FLOAT( Agrif_Parent(jpjglo)/2)*Agrif_Parent(ppe2_m) / (ra * rad) 
    469469         ENDIF 

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

    r1983 r2071  
    6262      IF( lk_zco )   CALL ctl_stop( 'dom_vvl : key_zco is incompatible with variable volume option key_vvl') 
    6363 
    64       IF( ln_zco) THEN 
    65          DO jk = 1, jpk 
    66             gdept(:,:,jk) = gdept_0(jk) 
    67             gdepw(:,:,jk) = gdepw_0(jk) 
    68             gdep3w(:,:,jk) = gdepw_0(jk) 
    69             e3t (:,:,jk) = e3t_0(jk) 
    70             e3u (:,:,jk) = e3t_0(jk) 
    71             e3v (:,:,jk) = e3t_0(jk) 
    72             e3f (:,:,jk) = e3t_0(jk) 
    73             e3w (:,:,jk) = e3w_0(jk) 
    74             e3uw(:,:,jk) = e3w_0(jk) 
    75             e3vw(:,:,jk) = e3w_0(jk) 
    76          END DO 
    77       ELSE 
    78          fsdept(:,:,:) = gdept (:,:,:) 
    79          fsdepw(:,:,:) = gdepw (:,:,:) 
    80          fsde3w(:,:,:) = gdep3w(:,:,:) 
    81          fse3t (:,:,:) = e3t   (:,:,:) 
    82          fse3u (:,:,:) = e3u   (:,:,:) 
    83          fse3v (:,:,:) = e3v   (:,:,:) 
    84          fse3f (:,:,:) = e3f   (:,:,:) 
    85          fse3w (:,:,:) = e3w   (:,:,:) 
    86          fse3uw(:,:,:) = e3uw  (:,:,:) 
    87          fse3vw(:,:,:) = e3vw  (:,:,:) 
    88       ENDIF 
     64      fsdept(:,:,:) = gdept (:,:,:) 
     65      fsdepw(:,:,:) = gdepw (:,:,:) 
     66      fsde3w(:,:,:) = gdep3w(:,:,:) 
     67      fse3t (:,:,:) = e3t   (:,:,:) 
     68      fse3u (:,:,:) = e3u   (:,:,:) 
     69      fse3v (:,:,:) = e3v   (:,:,:) 
     70      fse3f (:,:,:) = e3f   (:,:,:) 
     71      fse3w (:,:,:) = e3w   (:,:,:) 
     72      fse3uw(:,:,:) = e3uw  (:,:,:) 
     73      fse3vw(:,:,:) = e3vw  (:,:,:) 
    8974 
    9075      !                                 !==  mu computation  ==! 
    … …  
    154139      CALL lbc_lnk( sshf_b, 'F', 1. )   ;   CALL lbc_lnk( sshf_n, 'F', 1. ) 
    155140      ! 
    156          DO jk = 1, jpkm1 
    157             fsdept(:,:,jk) = fsdept_n(:,:,jk)          ! now local depths stored in fsdep. arrays 
    158             fsdepw(:,:,jk) = fsdepw_n(:,:,jk) 
    159             fsde3w(:,:,jk) = fsde3w_n(:,:,jk) 
    160             ! 
    161             fse3t (:,:,jk) = fse3t_n (:,:,jk)          ! vertical scale factors stored in fse3. arrays 
    162             fse3u (:,:,jk) = fse3u_n (:,:,jk) 
    163             fse3v (:,:,jk) = fse3v_n (:,:,jk) 
    164             fse3f (:,:,jk) = fse3f_n (:,:,jk) 
    165             fse3w (:,:,jk) = fse3w_n (:,:,jk) 
    166             fse3uw(:,:,jk) = fse3uw_n(:,:,jk) 
    167             fse3vw(:,:,jk) = fse3vw_n(:,:,jk) 
    168          END DO 
    169  
    170  
    171  
    172141   END SUBROUTINE dom_vvl 
    173142 

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

    r1929 r2071  
    4545      !!      domhgr, domzgr, and dommsk. Note: the file contain depends on 
    4646      !!      the vertical coord. used (z-coord, partial steps, s-coord) 
    47       !!            MOD(nmsh, 3) = 1  :   'mesh_mask.nc' file 
     47      !!                    nmsh = 1  :   'mesh_mask.nc' file 
    4848      !!                         = 2  :   'mesh.nc' and mask.nc' files 
    49       !!                         = 0  :   'mesh_hgr.nc', 'mesh_zgr.nc' and 
     49      !!                         = 3  :   'mesh_hgr.nc', 'mesh_zgr.nc' and 
    5050      !!                                  'mask.nc' files 
    5151      !!      For huge size domain, use option 2 or 3 depending on your  
    5252      !!      vertical coordinate. 
    53       !! 
    54       !!      if     nmsh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw] 
    55       !!      if 3 < nmsh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays  
    56       !!                        corresponding to the depth of the bottom points hdep[tw] 
    57       !!      if 6 < nmsh <= 9: write 2D arrays corresponding to the depth and the 
    58       !!                        thickness of the bottom points hdep[tw] and e3[tw]_ps 
    5953      !! 
    6054      !! ** output file :  
    … …  
    247241      !                                     !        close the files  
    248242      !                                     ! ============================ 
    249       SELECT CASE ( MOD(nmsh, 3) ) 
     243      SELECT CASE ( nmsh ) 
    250244      CASE ( 1 )                 
    251245         CALL iom_close( inum0 ) 
    … …  
    253247         CALL iom_close( inum1 ) 
    254248         CALL iom_close( inum2 ) 
    255       CASE ( 0 ) 
     249      CASE ( 3 ) 
    256250         CALL iom_close( inum2 ) 
    257251         CALL iom_close( inum3 ) 

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

    r2044 r2071  
    44   !!     Definition of of both ocean and ice parameters used in the code 
    55   !!===================================================================== 
    6    !! History :   OPA  !  1990-10  (C. Levy - G. Madec)  Original code 
    7    !!             8.1  !  1991-11  (G. Madec, M. Imbard)  cosmetic changes 
    8    !!   NEMO      1.0  !  2002-08  (G. Madec, C. Ethe)  F90, add ice constants 
    9    !!              -   !  2006-08  (G. Madec)  style  
    10    !!             3.2  !  2006-08  (S. Masson, G. Madec)  suppress useless variables + style  
     6   !! History :        !  90-10  (C. Levy - G. Madec)  Original code 
     7   !!                  !  91-11  (G. Madec) 
     8   !!                  !  91-12  (M. Imbard) 
     9   !!             8.5  !  02-08  (G. Madec, C. Ethe)  F90, add ice constants 
     10   !!             9.0  !  06-08  (G. Madec) style  
    1111   !!---------------------------------------------------------------------- 
    1212 
    … …  
    2424   REAL(wp), PUBLIC ::   rpi = 3.141592653589793_wp             !: pi 
    2525   REAL(wp), PUBLIC ::   rad = 3.141592653589793_wp / 180._wp   !: conversion from degre into radian 
    26    REAL(wp), PUBLIC ::   rsmall = 0.5 * EPSILON( 1.e0 )         !: smallest real computer value 
     26   REAL(wp), PUBLIC ::   rsmall = 0.5 * EPSILON( 1. )           !: smallest real computer value 
    2727    
    28    REAL(wp), PUBLIC ::   rday = 24.*60.*60.       !: day (s) 
    29    REAL(wp), PUBLIC ::   rsiyea                   !: sideral year (s) 
    30    REAL(wp), PUBLIC ::   rsiday                   !: sideral day (s) 
    31    REAL(wp), PUBLIC ::   raamo =  12._wp          !: number of months in one year 
    32    REAL(wp), PUBLIC ::   rjjhh =  24._wp          !: number of hours in one day 
    33    REAL(wp), PUBLIC ::   rhhmm =  60._wp          !: number of minutes in one hour 
    34    REAL(wp), PUBLIC ::   rmmss =  60._wp          !: number of seconds in one minute 
    35 !! REAL(wp), PUBLIC ::   omega = 7.292115083046061e-5_wp ,  &  !: change the last digit! 
    36    REAL(wp), PUBLIC ::   omega                    !: earth rotation parameter 
    37    REAL(wp), PUBLIC ::   ra    = 6371229._wp      !: earth radius (meter) 
    38    REAL(wp), PUBLIC ::   grav  = 9.80665_wp       !: gravity (m/s2) 
     28   REAL(wp), PUBLIC ::          & !: 
     29      rday = 24.*60.*60.  ,     & !: day (s) 
     30      rsiyea              ,     & !: sideral year (s) 
     31      rsiday              ,     & !: sideral day (s) 
     32      raamo =  12._wp     ,     & !: number of months in one year 
     33      rjjhh =  24._wp     ,     & !: number of hours in one day 
     34      rhhmm =  60._wp     ,     & !: number of minutes in one hour 
     35      rmmss =  60._wp     ,     & !: number of seconds in one minute 
     36!!!   omega = 7.292115083046061e-5_wp ,  &  !: change the last digit! 
     37      omega               ,    &  !: earth rotation parameter 
     38      ra    = 6371229._wp ,    &  !: earth radius (meter) 
     39      grav  = 9.80665_wp          !: gravity (m/s2) 
    3940    
    40    REAL(wp), PUBLIC ::   rtt      = 273.16_wp     !: triple point of temperature (Kelvin) 
    41    REAL(wp), PUBLIC ::   rt0      = 273.15_wp     !: freezing point of water (Kelvin) 
     41   REAL(wp), PUBLIC ::         &  !: 
     42      rtt      = 273.16_wp  ,  &  !: triple point of temperature (Kelvin) 
     43      rt0      = 273.15_wp  ,  &  !: freezing point of water (Kelvin) 
    4244#if defined key_lim3 
    43    REAL(wp), PUBLIC ::   rt0_snow = 273.16_wp     !: melting point of snow  (Kelvin) 
    44    REAL(wp), PUBLIC ::   rt0_ice  = 273.16_wp     !: melting point of ice   (Kelvin) 
     45      rt0_snow = 273.16_wp  ,  &  !: melting point of snow  (Kelvin) 
     46      rt0_ice  = 273.16_wp  ,  &  !: melting point of ice   (Kelvin) 
    4547#else 
    46    REAL(wp), PUBLIC ::   rt0_snow = 273.15_wp     !: melting point of snow  (Kelvin) 
    47    REAL(wp), PUBLIC ::   rt0_ice  = 273.05_wp     !: melting point of ice   (Kelvin) 
     48      rt0_snow = 273.15_wp  ,  &  !: melting point of snow  (Kelvin) 
     49      rt0_ice  = 273.05_wp  ,  &  !: melting point of ice   (Kelvin) 
    4850#endif 
     51      rau0     = 1035._wp   ,  &  !: volumic mass of reference (kg/m3) 
     52      rauw     = 1000._wp   ,  &  !: volumic mass of pure water (kg/m3) 
     53      rcp      =    4.e+3_wp,  &  !: ocean specific heat 
     54      ro0cpr                      !: = 1. / ( rau0 * rcp ) 
    4955 
    50    REAL(wp), PUBLIC ::   rau0     = 1020._wp      !: reference volumic mass (density)  (kg/m3) 
    51    REAL(wp), PUBLIC ::   rau0r                    !: reference specific volume         (m3/kg) 
    52    REAL(wp), PUBLIC ::   rcp      =    4.e+3_wp   !: ocean specific heat 
    53    REAL(wp), PUBLIC ::   ro0cpr                   !: = 1. / ( rau0 * rcp ) 
    54  
     56   REAL(wp), PUBLIC ::            &  !: 
    5557#if defined key_lim3 
    56    REAL(wp), PUBLIC ::   rcdsn   =   0.31_wp      !: thermal conductivity of snow 
    57    REAL(wp), PUBLIC ::   rcdic   =   2.034396_wp  !: thermal conductivity of fresh ice 
    58    REAL(wp), PUBLIC ::   cpic    = 2067.0         !: specific heat of sea ice 
    59    REAL(wp), PUBLIC ::   lsub    = 2.834e+6       !: pure ice latent heat of sublimation (J.kg-1) 
    60    REAL(wp), PUBLIC ::   lfus    = 0.334e+6       !: latent heat of fusion of fresh ice   (J.kg-1) 
    61    REAL(wp), PUBLIC ::   rhoic   = 917._wp        !: volumic mass of sea ice (kg/m3) 
    62    REAL(wp), PUBLIC ::   tmut    =   0.054        !: decrease of seawater meltpoint with salinity 
     58      rcdsn   =   0.31_wp     ,   &  !: thermal conductivity of snow 
     59      rcdic   =   2.034396_wp ,   &  !: thermal conductivity of fresh ice 
     60      cpic    = 2067.0        ,   & 
     61      ! add the following lines 
     62      lsub    = 2.834e+6      ,   &  !: pure ice latent heat of sublimation (J.kg-1) 
     63      lfus    = 0.334e+6      ,   &  !: latent heat of fusion of fresh ice   (J.kg-1) 
     64      rhoic   = 917._wp       ,   &  !: volumic mass of sea ice (kg/m3) 
     65      tmut    =   0.054       ,   &  !: decrease of seawater meltpoint with salinity 
    6366#else 
    64    REAL(wp), PUBLIC ::   rcdsn   =   0.22_wp      !: conductivity of the snow 
    65    REAL(wp), PUBLIC ::   rcdic   =   2.034396_wp  !: conductivity of the ice 
    66    REAL(wp), PUBLIC ::   rcpsn   =   6.9069e+5_wp !: density times specific heat for snow 
    67    REAL(wp), PUBLIC ::   rcpic   =   1.8837e+6_wp !: volumetric latent heat fusion of sea ice 
    68    REAL(wp), PUBLIC ::   lfus    =   0.3337e+6    !: latent heat of fusion of fresh ice   (J.kg-1)     
    69    REAL(wp), PUBLIC ::   xlsn    = 110.121e+6_wp  !: volumetric latent heat fusion of snow 
    70    REAL(wp), PUBLIC ::   xlic    = 300.33e+6_wp   !: volumetric latent heat fusion of ice 
    71    REAL(wp), PUBLIC ::   xsn     =   2.8e+6       !: latent heat of sublimation of snow 
    72    REAL(wp), PUBLIC ::   rhoic   = 900._wp        !: volumic mass of sea ice (kg/m3) 
     67      rcdsn   =   0.22_wp     ,   &  !: conductivity of the snow 
     68      rcdic   =   2.034396_wp ,   &  !: conductivity of the ice 
     69      rcpsn   =   6.9069e+5_wp,   &  !: density times specific heat for snow 
     70      rcpic   =   1.8837e+6_wp,   &  !: volumetric latent heat fusion of sea ice 
     71      xlsn    = 110.121e+6_wp ,   &  !: volumetric latent heat fusion of snow 
     72      xlic    = 300.33e+6_wp  ,   &  !: volumetric latent heat fusion of ice 
     73      xsn     =   2.8e+6      ,   &  !: latent heat of sublimation of snow 
     74      rhoic   = 900._wp       ,   &  !: volumic mass of sea ice (kg/m3) 
    7375#endif 
    74    REAL(wp), PUBLIC ::   rhosn   = 330._wp        !: volumic mass of snow (kg/m3) 
    75    REAL(wp), PUBLIC ::   emic    =   0.97_wp      !: emissivity of snow or ice 
    76    REAL(wp), PUBLIC ::   sice    =   6.0_wp       !: reference salinity of ice (psu) 
    77    REAL(wp), PUBLIC ::   soce    =  34.7_wp       !: reference salinity of sea (psu) 
    78    REAL(wp), PUBLIC ::   cevap   =   2.5e+6_wp    !: latent heat of evaporation (water) 
    79    REAL(wp), PUBLIC ::   srgamma =   0.9_wp       !: correction factor for solar radiation (Oberhuber, 1974) 
    80    REAL(wp), PUBLIC ::   vkarmn  =   0.4_wp       !: von Karman constant 
    81    REAL(wp), PUBLIC ::   stefan  =   5.67e-8_wp   !: Stefan-Boltzmann constant  
    82    !!---------------------------------------------------------------------- 
    83    !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)  
    84    !! $Id$  
    85    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 
    86    !!---------------------------------------------------------------------- 
     76      rhosn   = 330._wp       ,   &  !: volumic mass of snow (kg/m3) 
     77      emic    =   0.97_wp     ,   &  !: emissivity of snow or ice 
     78      sice    =   6.0_wp      ,   &  !: salinity of ice (psu) 
     79      soce    =  34.7_wp      ,   &  !: salinity of sea (psu) 
     80      cevap   =   2.5e+6_wp   ,   &  !: latent heat of evaporation (water) 
     81      srgamma =   0.9_wp      ,   &  !: correction factor for solar radiation (Oberhuber, 1974) 
     82      vkarmn  =   0.4_wp      ,   &  !: von Karman constant 
     83      stefan  =   5.67e-8_wp         !: Stefan-Boltzmann constant  
     84      !!---------------------------------------------------------------------- 
     85      !!  OPA 9.0 , LOCEAN-IPSL (2005)  
     86      !! $Id$  
     87      !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     88      !!---------------------------------------------------------------------- 
    8789    
    8890CONTAINS 
    … …  
    9799      !!---------------------------------------------------------------------- 
    98100 
    99       !                                   ! Define additional parameters 
    100       rsiyea = 365.25 * rday * 2. * rpi / 6.283076 
    101       rsiday = rday / ( 1. + rday / rsiyea ) 
    102       omega  = 2. * rpi / rsiday  
     101      IF(lwp) WRITE(numout,*) 
     102      IF(lwp) WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants' 
     103      IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
    103104 
    104       rau0r  = 1. /   rau0   
    105       ro0cpr = 1. / ( rau0 * rcp ) 
    106  
    107  
    108       IF(lwp) THEN                        ! control print 
    109          WRITE(numout,*) 
    110          WRITE(numout,*) ' phy_cst : initialization of ocean parameters and constants' 
    111          WRITE(numout,*) ' ~~~~~~~' 
     105      ! Ocean Parameters 
     106      ! ---------------- 
     107      IF(lwp) THEN 
    112108         WRITE(numout,*) '       Domain info' 
    113109         WRITE(numout,*) '          dimension of model' 
    … …  
    122118         WRITE(numout,*) '             jpnij   : ', jpnij 
    123119         WRITE(numout,*) '          lateral domain boundary condition type : jperio  = ', jperio 
    124          WRITE(numout,*) 
    125          WRITE(numout,*) '       Constants' 
    126          WRITE(numout,*) 
    127          WRITE(numout,*) '          mathematical constant                 rpi = ', rpi 
    128          WRITE(numout,*) '          day                                rday   = ', rday,   ' s' 
    129          WRITE(numout,*) '          sideral year                       rsiyea = ', rsiyea, ' s' 
    130          WRITE(numout,*) '          sideral day                        rsiday = ', rsiday, ' s' 
    131          WRITE(numout,*) '          omega                              omega  = ', omega,  ' s-1' 
    132          WRITE(numout,*) 
    133          WRITE(numout,*) '          nb of months per year               raamo = ', raamo, ' months' 
    134          WRITE(numout,*) '          nb of hours per day                 rjjhh = ', rjjhh, ' hours' 
    135          WRITE(numout,*) '          nb of minutes per hour              rhhmm = ', rhhmm, ' mn' 
    136          WRITE(numout,*) '          nb of seconds per minute            rmmss = ', rmmss, ' s' 
    137          WRITE(numout,*) 
    138          WRITE(numout,*) '          earth radius                         ra   = ', ra, ' m' 
    139          WRITE(numout,*) '          gravity                              grav = ', grav , ' m/s^2' 
    140          WRITE(numout,*) 
    141          WRITE(numout,*) '          triple point of temperature      rtt      = ', rtt     , ' K' 
    142          WRITE(numout,*) '          freezing point of water          rt0      = ', rt0     , ' K' 
    143          WRITE(numout,*) '          melting point of snow            rt0_snow = ', rt0_snow, ' K' 
    144          WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K' 
    145          WRITE(numout,*) 
    146          WRITE(numout,*) '          ocean reference volumic mass       rau0   = ', rau0 , ' kg/m^3' 
    147          WRITE(numout,*) '          ocean reference specific volume    rau0r  = ', rau0r, ' m^3/Kg' 
    148          WRITE(numout,*) '          ocean specific heat                rcp    = ', rcp 
    149          WRITE(numout,*) '                       1. / ( rau0 * rcp ) = ro0cpr = ', ro0cpr 
     120      ENDIF 
     121 
     122      ! Define constants 
     123      ! ---------------- 
     124      IF(lwp) WRITE(numout,*) 
     125      IF(lwp) WRITE(numout,*) '       Constants' 
     126 
     127      IF(lwp) WRITE(numout,*) 
     128      IF(lwp) WRITE(numout,*) '          mathematical constant                 rpi = ', rpi 
     129 
     130      rsiyea = 365.25 * rday * 2. * rpi / 6.283076 
     131      rsiday = rday / ( 1. + rday / rsiyea ) 
     132      omega  = 2. * rpi / rsiday  
     133      IF(lwp) WRITE(numout,*) 
     134      IF(lwp) WRITE(numout,*) '          day                                rday   = ', rday,   ' s' 
     135      IF(lwp) WRITE(numout,*) '          sideral year                       rsiyea = ', rsiyea, ' s' 
     136      IF(lwp) WRITE(numout,*) '          sideral day                        rsiday = ', rsiday, ' s' 
     137      IF(lwp) WRITE(numout,*) '          omega                              omega  = ', omega,  ' s-1' 
     138 
     139      IF(lwp) WRITE(numout,*) 
     140      IF(lwp) WRITE(numout,*) '          nb of months per year               raamo = ', raamo, ' months' 
     141      IF(lwp) WRITE(numout,*) '          nb of hours per day                 rjjhh = ', rjjhh, ' hours' 
     142      IF(lwp) WRITE(numout,*) '          nb of minutes per hour              rhhmm = ', rhhmm, ' mn' 
     143      IF(lwp) WRITE(numout,*) '          nb of seconds per minute            rmmss = ', rmmss, ' s' 
     144 
     145      IF(lwp) WRITE(numout,*) 
     146      IF(lwp) WRITE(numout,*) '          earth radius                         ra   = ', ra, ' m' 
     147      IF(lwp) WRITE(numout,*) '          gravity                              grav = ', grav , ' m/s^2' 
     148 
     149      IF(lwp) WRITE(numout,*) 
     150      IF(lwp) WRITE(numout,*) '          triple point of temperature      rtt      = ', rtt     , ' K' 
     151      IF(lwp) WRITE(numout,*) '          freezing point of water          rt0      = ', rt0     , ' K' 
     152      IF(lwp) WRITE(numout,*) '          melting point of snow            rt0_snow = ', rt0_snow, ' K' 
     153      IF(lwp) WRITE(numout,*) '          melting point of ice             rt0_ice  = ', rt0_ice , ' K' 
     154 
     155      ro0cpr = 1. / ( rau0 * rcp ) 
     156      IF(lwp) WRITE(numout,*) 
     157      IF(lwp) WRITE(numout,*) '          volumic mass of pure water         rauw   = ', rauw, ' kg/m^3' 
     158      IF(lwp) WRITE(numout,*) '          volumic mass of reference          rau0   = ', rau0, ' kg/m^3' 
     159      IF(lwp) WRITE(numout,*) '          ocean specific heat                rcp    = ', rcp 
     160      IF(lwp) WRITE(numout,*) '                       1. / ( rau0 * rcp ) = ro0cpr = ', ro0cpr 
     161 
     162      IF(lwp) THEN 
    150163         WRITE(numout,*) 
    151164         WRITE(numout,*) '          thermal conductivity of the snow          = ', rcdsn   , ' J/s/m/K' 
    … …  
    171184         WRITE(numout,*) '          von Karman constant                       = ', vkarmn  
    172185         WRITE(numout,*) '          Stefan-Boltzmann constant                 = ', stefan  , ' J/s/m^2/K^4' 
     186 
    173187         WRITE(numout,*) 
    174188         WRITE(numout,*) '          conversion: degre ==> radian          rad = ', rad 
     189 
    175190         WRITE(numout,*) 
    176191         WRITE(numout,*) '          smallest real computer value       rsmall = ', rsmall 

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

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

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

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

  • branches/devmercator2010/NEMO/OPA_SRC/DYN/divcur.F90

    r1792 r2071  
    123123 
    124124#if defined key_obc 
    125          IF( Agrif_Root() ) THEN 
    126             ! open boundaries (div must be zero behind the open boundary) 
    127             !  mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 
    128             IF( lp_obc_east  )   hdivn(nie0p1:nie1p1,nje0  :nje1  ,jk) = 0.e0      ! east 
    129             IF( lp_obc_west  )   hdivn(niw0  :niw1  ,njw0  :njw1  ,jk) = 0.e0      ! west 
    130             IF( lp_obc_north )   hdivn(nin0  :nin1  ,njn0p1:njn1p1,jk) = 0.e0      ! north 
    131             IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south 
     125#if defined key_agrif 
     126         IF (Agrif_Root() ) THEN 
     127#endif 
     128         ! open boundaries (div must be zero behind the open boundary) 
     129         !  mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 
     130         IF( lp_obc_east  )   hdivn(nie0p1:nie1p1,nje0  :nje1  ,jk) = 0.e0      ! east 
     131         IF( lp_obc_west  )   hdivn(niw0  :niw1  ,njw0  :njw1  ,jk) = 0.e0      ! west 
     132         IF( lp_obc_north )   hdivn(nin0  :nin1  ,njn0p1:njn1p1,jk) = 0.e0      ! north 
     133         IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south 
     134#if defined key_agrif 
    132135         ENDIF 
     136#endif 
    133137#endif          
    134138#if defined key_bdy 
    135139         ! unstructured open boundaries (div must be zero behind the open boundary) 
    136140         DO jj = 1, jpj 
    137             DO ji = 1, jpi 
    138                hdivn(ji,jj,jk)=hdivn(ji,jj,jk)*bdytmask(ji,jj) 
    139             END DO 
     141           DO ji = 1, jpi 
     142             hdivn(ji,jj,jk)=hdivn(ji,jj,jk)*bdytmask(ji,jj) 
     143           END DO 
    140144         END DO 
    141145#endif          
    142          IF( .NOT. AGRIF_Root() ) THEN 
    143             IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east 
    144             IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2      , :     ,jk) = 0.e0      ! west 
    145             IF ((nbondj ==  1).OR.(nbondj == 2)) hdivn(:      ,nlcj-1 ,jk) = 0.e0      ! north 
    146             IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(:      ,2      ,jk) = 0.e0      ! south 
    147          ENDIF 
     146#if defined key_agrif 
     147         if ( .NOT. AGRIF_Root() ) then 
     148           IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east 
     149           IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2      , :     ,jk) = 0.e0      ! west 
     150           IF ((nbondj ==  1).OR.(nbondj == 2)) hdivn(:      ,nlcj-1 ,jk) = 0.e0      ! north 
     151           IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(:      ,2      ,jk) = 0.e0      ! south 
     152         endif 
     153#endif     
    148154 
    149155         !                                             ! -------- 
    … …  
    335341 
    336342#if defined key_obc 
    337          IF( Agrif_Root() ) THEN 
    338             ! open boundaries (div must be zero behind the open boundary) 
    339             !  mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 
    340             IF( lp_obc_east  )   hdivn(nie0p1:nie1p1,nje0  :nje1  ,jk) = 0.e0      ! east 
    341             IF( lp_obc_west  )   hdivn(niw0  :niw1  ,njw0  :njw1  ,jk) = 0.e0      ! west 
    342             IF( lp_obc_north )   hdivn(nin0  :nin1  ,njn0p1:njn1p1,jk) = 0.e0      ! north 
    343             IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south 
     343#if defined key_agrif 
     344         IF ( Agrif_Root() ) THEN 
     345#endif 
     346         ! open boundaries (div must be zero behind the open boundary) 
     347         !  mpp remark: The zeroing of hdivn can probably be extended to 1->jpi/jpj for the correct row/column 
     348         IF( lp_obc_east  )   hdivn(nie0p1:nie1p1,nje0  :nje1  ,jk) = 0.e0      ! east 
     349         IF( lp_obc_west  )   hdivn(niw0  :niw1  ,njw0  :njw1  ,jk) = 0.e0      ! west 
     350         IF( lp_obc_north )   hdivn(nin0  :nin1  ,njn0p1:njn1p1,jk) = 0.e0      ! north 
     351         IF( lp_obc_south )   hdivn(nis0  :nis1  ,njs0  :njs1  ,jk) = 0.e0      ! south 
     352#if defined key_agrif 
    344353         ENDIF 
     354#endif 
    345355#endif          
    346356#if defined key_bdy 
    … …  
    352362         END DO 
    353363#endif         
    354          IF( .NOT. AGRIF_Root() ) THEN 
     364#if defined key_agrif 
     365         if ( .NOT. AGRIF_Root() ) then 
    355366            IF ((nbondi ==  1).OR.(nbondi == 2)) hdivn(nlci-1 , :     ,jk) = 0.e0      ! east 
    356367            IF ((nbondi == -1).OR.(nbondi == 2)) hdivn(2      , :     ,jk) = 0.e0      ! west 
    357368            IF ((nbondj ==  1).OR.(nbondj == 2)) hdivn(:      ,nlcj-1 ,jk) = 0.e0      ! north 
    358369            IF ((nbondj == -1).OR.(nbondj == 2)) hdivn(:      ,2      ,jk) = 0.e0      ! south 
    359          ENDIF 
     370         endif 
     371#endif     
    360372 
    361373         !                                             ! -------- 

  • branches/devmercator2010/NEMO/OPA_SRC/DYN/dynnxt.F90

    r1876 r2071  
    146146# if defined key_obc 
    147147      !                                !* OBC open boundaries 
    148       IF( lk_obc )   CALL obc_dyn( kt ) 
     148      CALL obc_dyn( kt ) 
    149149      ! 
    150150      IF ( lk_dynspg_exp .OR. lk_dynspg_ts ) THEN 

  • branches/devmercator2010/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r1876 r2071  
    186186 
    187187#if defined key_obc 
    188       IF( lk_obc )   CALL obc_dyn( kt )   ! Update velocities on each open boundary with the radiation algorithm 
    189       IF( lk_obc )   CALL obc_vol( kt )   ! Correction of the barotropic componant velocity to control the volume of the system 
     188      CALL obc_dyn( kt )      ! Update velocities on each open boundary with the radiation algorithm 
     189      CALL obc_vol( kt )      ! Correction of the barotropic componant velocity to control the volume of the system 
    190190#endif 
    191191#if defined key_bdy 
    … …  
    315315#if defined key_obc 
    316316            ! caution : grad D = 0 along open boundaries 
    317             IF( Agrif_Root() ) THEN 
    318                spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj) 
    319                spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj) 
    320             ELSE 
    321                spgu(ji,jj) = z2dt * ztdgu 
    322                spgv(ji,jj) = z2dt * ztdgv 
    323             ENDIF 
     317            spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj) 
     318            spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj) 
    324319#elif defined key_bdy 
    325320            ! caution : grad D = 0 along open boundaries 

  • branches/devmercator2010/NEMO/OPA_SRC/DYN/sshwzv.F90

    r1792 r2071  
    157157 
    158158#if defined key_obc 
     159# if defined key_agrif 
    159160      IF ( Agrif_Root() ) THEN  
     161# endif 
    160162         ssha(:,:) = ssha(:,:) * obctmsk(:,:) 
    161163         CALL lbc_lnk( ssha, 'T', 1. )  ! absolutly compulsory !! (jmm) 
    162       ENDIF 
     164# if defined key_agrif 
     165      ENDIF 
     166# endif 
    163167#endif 
    164168 

  • branches/devmercator2010/NEMO/OPA_SRC/IOM/iom.F90

    r1793 r2071  
    4343   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag 
    4444#endif 
    45    PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 
     45   PUBLIC iom_init, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 
    4646 
    4747   PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 
    … …  
    8686      !!---------------------------------------------------------------------- 
    8787      ! read the xml file 
    88       IF( Agrif_Root() ) CALL event__parse_xml_file( 'iodef.xml' )   ! <- to get from the nameliste (namrun)... 
    89       CALL iom_swap 
     88      CALL event__parse_xml_file( 'iodef.xml' )   ! <- to get from the nameliste (namrun)... 
    9089 
    9190      ! calendar parameters 
    … …  
    120119 
    121120   END SUBROUTINE iom_init 
    122  
    123  
    124    SUBROUTINE iom_swap 
    125       !!--------------------------------------------------------------------- 
    126       !!                   ***  SUBROUTINE  iom_swap  *** 
    127       !! 
    128       !! ** Purpose :  swap context between different agrif grid for xmlio_server 
    129       !!--------------------------------------------------------------------- 
    130 #if defined key_iomput 
    131  
    132      IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
    133         CALL event__swap_context("nemo") 
    134      ELSE 
    135         CALL event__swap_context(TRIM(Agrif_CFixed())//"_nemo") 
    136      ENDIF 
    137  
    138 #endif 
    139    END SUBROUTINE iom_swap 
    140121 
    141122 
    … …  
    183164      ! if iom_open is called for the first time: initialize iom_file(:)%nfid to 0 
    184165      ! (could be done when defining iom_file in f95 but not in f90) 
     166#if ! defined key_agrif 
     167      IF( iom_open_init == 0 ) THEN 
     168         iom_file(:)%nfid = 0 
     169         iom_open_init = 1 
     170      ENDIF 
     171#else 
    185172      IF( Agrif_Root() ) THEN 
    186173         IF( iom_open_init == 0 ) THEN 
    … …  
    189176         ENDIF 
    190177      ENDIF 
     178#endif 
    191179      ! do we read or write the file? 
    192180      IF( PRESENT(ldwrt) ) THEN   ;   llwrt = ldwrt 
    … …  
    211199      ! ============= 
    212200      clname   = trim(cdname) 
     201#if defined key_agrif 
    213202      IF ( .NOT. Agrif_Root() .AND. .NOT. lliof ) THEN 
    214203         iln    = INDEX(clname,'/')  
    … …  
    217206         clname=TRIM(cltmpn)//TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    218207      ENDIF 
     208#endif     
    219209      ! which suffix should we use? 
    220210      SELECT CASE (iolib) 

  • branches/devmercator2010/NEMO/OPA_SRC/IOM/prtctl.F90

    r2029 r2071  
    120120      IF( PRESENT(tab2d_1) )  ztab2d_1(:,:)  = tab2d_1(:,:) 
    121121      IF( PRESENT(tab2d_2) )  ztab2d_2(:,:)  = tab2d_2(:,:) 
    122       IF( PRESENT(tab3d_1) )  ztab3d_1(:,:,1:kdir)= tab3d_1(:,:,:) 
    123       IF( PRESENT(tab3d_2) )  ztab3d_2(:,:,1:kdir)= tab3d_2(:,:,:) 
     122      IF( PRESENT(tab3d_1) )  ztab3d_1(:,:,:)= tab3d_1(:,:,:) 
     123      IF( PRESENT(tab3d_2) )  ztab3d_2(:,:,:)= tab3d_2(:,:,:) 
    124124      IF( PRESENT(mask1)   )  zmask1  (:,:,:)= mask1  (:,:,:) 
    125125      IF( PRESENT(mask2)   )  zmask2  (:,:,:)= mask2  (:,:,:) 

  • branches/devmercator2010/NEMO/OPA_SRC/OBC/obc_oce.F90

    r1818 r2071  
    2727   ! 
    2828   !                                  !!* Namelist namobc: open boundary condition * 
     29   INTEGER           ::   nn_nbobc    = 2        !: number of open boundaries ( 1=< nbobc =< 4 )  
    2930   INTEGER           ::   nn_obcdta   = 0        !:  = 0 use the initial state as obc data 
    3031   !                                             !   = 1 read obc data in obcxxx.dta files 

  • branches/devmercator2010/NEMO/OPA_SRC/OBC/obc_par.F90

    r2031 r2071  
    2525   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    2626   !!---------------------------------------------------------------------- 
    27 #if ! defined key_agrif 
    28    LOGICAL, PUBLIC, PARAMETER ::   lk_obc = .TRUE.     !: Ocean Boundary Condition flag 
    29 #else 
    30    LOGICAL, PUBLIC            ::   lk_obc = .TRUE.     !: Ocean Boundary Condition flag 
    31 #endif 
     27   LOGICAL, PUBLIC, PARAMETER ::   lk_obc = .TRUE.   !: Ocean Boundary Condition flag 
    3228 
    3329# if defined key_eel_r5 
    … …  
    5248   LOGICAL, PARAMETER ::     &  !: 
    5349      lp_obc_east = .FALSE.     !: to active or not the East open boundary 
    54      INTEGER   & 
    55 #if !defined key_agrif 
    56      , PARAMETER   &  
    57 #endif 
    58     ::     &  
     50   INTEGER, PARAMETER ::     &  !: 
    5951      jpieob  = jpiglo-2,    &  !: i-localization of the East open boundary (must be ocean U-point) 
    6052      jpjed   =        2,    &  !: j-starting indice of the East open boundary (must be land T-point) 
    … …  
    6658   LOGICAL, PARAMETER ::     &  !: 
    6759      lp_obc_west = .FALSE.     !: to active or not the West open boundary 
    68      INTEGER   & 
    69 #if !defined key_agrif 
    70      , PARAMETER   &  
    71 #endif 
    72     ::     &  
     60   INTEGER, PARAMETER ::     &  !: 
    7361      jpiwob  =          2,    &  !: i-localization of the West open boundary (must be ocean U-point) 
    7462      jpjwd   =          2,    &  !: j-starting indice of the West open boundary (must be land T-point) 
    … …  
    8068   LOGICAL, PARAMETER ::     &  !: 
    8169      lp_obc_north = .FALSE.    !: to active or not the North open boundary 
    82      INTEGER   & 
    83 #if !defined key_agrif 
    84      , PARAMETER   &  
    85 #endif 
    86     ::     &  
     70   INTEGER, PARAMETER ::     &  !: 
    8771      jpjnob  = jpjglo-2,    &  !: j-localization of the North open boundary (must be ocean V-point) 
    8872      jpind   =        2,    &  !: i-starting indice of the North open boundary (must be land T-point) 
    … …  
    9478   LOGICAL, PARAMETER ::     &  !: 
    9579      lp_obc_south = .FALSE.    !: to active or not the South open boundary 
    96      INTEGER   & 
    97 #if !defined key_agrif 
    98      , PARAMETER   &  
    99 #endif 
    100     ::     &  
     80   INTEGER, PARAMETER ::     &  !: 
    10181      jpjsob  =        2,    &  !: j-localization of the South open boundary (must be ocean V-point) 
    10282      jpisd   =        2,    &  !: i-starting indice of the South open boundary (must be land T-point) 

  • branches/devmercator2010/NEMO/OPA_SRC/OBC/obc_par_EEL_R5.h90

    r1876 r2071  
    1515   LOGICAL, PARAMETER ::     &  !: 
    1616      lp_obc_east = .TRUE.      !: to active or not the East open boundary 
    17  
    18      INTEGER   & 
    19 #if !defined key_agrif 
    20      , PARAMETER   & 
    21 #endif 
    22     ::     & 
     17   INTEGER, PARAMETER ::     &  !: 
    2318      jpieob  = jpiglo-2,    &  !: i-localization of the East open boundary (must be ocean U-point) 
    2419      jpjed   =        2,    &  !: j-starting indice of the East open boundary (must be land T-point) 
    … …  
    3025   LOGICAL, PARAMETER ::     &  !: 
    3126      lp_obc_west = .TRUE.      !: to active or not the West open boundary 
    32  
    33      INTEGER   & 
    34 #if !defined key_agrif 
    35      , PARAMETER   & 
    36 #endif 
    37     ::     & 
     27   INTEGER, PARAMETER ::     & 
    3828      jpiwob  =          2,    &  !: i-localization of the West open boundary (must be ocean U-point) 
    3929      jpjwd   =          2,    &  !: j-starting indice of the West open boundary (must be land T-point) 
    … …  
    4535   LOGICAL, PARAMETER ::     &  !: 
    4636      lp_obc_north = .FALSE.    !: to active or not the North open boundary 
    47  
    48      INTEGER   & 
    49 #if !defined key_agrif 
    50      , PARAMETER   & 
    51 #endif 
    52     ::     & 
     37   INTEGER, PARAMETER ::     &  !: 
    5338      jpjnob  = jpjglo-2,    &  !: j-localization of the North open boundary (must be ocean V-point) 
    5439      jpind   =        2,    &  !: i-starting indice of the North open boundary (must be land T-point) 
    … …  
    6045   LOGICAL, PARAMETER ::     &  !: 
    6146      lp_obc_south = .FALSE.    !: to active or not the South open boundary 
    62  
    63      INTEGER   & 
    64 #if !defined key_agrif 
    65      , PARAMETER   & 
    66 #endif 
    67     ::     & 
     47   INTEGER, PARAMETER ::     &  !: 
    6848      jpjsob  =        2,    &  !: j-localization of the South open boundary (must be ocean V-point) 
    6949      jpisd   =        2,    &  !: i-starting indice of the South open boundary (must be land T-point) 

  • branches/devmercator2010/NEMO/OPA_SRC/OBC/obc_par_POMME_R025.h90

    r1876 r2071  
    44   !! open boundary parameter : POMME configuration 
    55   !!--------------------------------------------------------------------- 
    6    INTEGER, PARAMETER ::  jptobc  =       14    
    7    !: time dimension of the BCS fields on input 
     6     INTEGER, PARAMETER ::     &  !: time dimension of the BCS fields on input 
     7      jptobc  =         14 
    88 
    99   !! * EAST open boundary 
    1010   LOGICAL, PARAMETER ::     &  !: 
    1111      lp_obc_east = .TRUE.      !: 
     12   INTEGER, PARAMETER ::     &  !: 
    1213 
    13      INTEGER   & 
    14 #if !defined key_agrif 
    15      , PARAMETER   &  
    16 #endif 
    17     ::     &  
    1814      ! * default values * 
    1915      !jpieob = jpiglo-2,    &  !: i-localization of the East open boundary (must be ocean U-point) 
    2016      !jpjed  =        2,    &  !: j-starting indice of the East open boundary (must be land T-point) 
    2117      !jpjef  = jpjglo-1,    &  !: j-ending   indice of the East open boundary (must be land T-point) 
     18 
    2219      jpieob = jpiglo-2,    &  !: i-localization of the East open boundary (must be ocean U-point) 
    2320      jpjed  =        1,    &  !: j-starting indice of the East open boundary (must be land T-point) 
    2421      jpjef  =   jpjglo,    &  !: j-ending   indice of the East open boundary (must be land T-point) 
     22 
    2523      jpjedp1 =  jpjed+1,    &  !: first ocean point         "                 " 
    2624      jpjefm1 =  jpjef-1        !: last  ocean point         "                 " 
    … …  
    2927   LOGICAL, PARAMETER ::     &  !: 
    3028      lp_obc_west = .TRUE.     !: to active or not the West open boundary 
     29   INTEGER, PARAMETER ::     &  !: 
    3130 
    32      INTEGER   & 
    33 #if !defined key_agrif 
    34      , PARAMETER   &  
    35 #endif 
    36     ::     &  
    3731      ! * default values * 
    3832      !jpiwob  =        2,   &  !: i-localization of the West open boundary (must be ocean U-point) 
    3933      !jpjwd   =        2,   &  !: j-starting indice of the West open boundary (must be land T-point) 
    4034      !jpjwf   = jpjglo-1,   &  !: j-ending   indice of the West open boundary (must be land T-point) 
     35 
    4136      jpiwob  =        2,   &  !: i-localization of the West open boundary (must be ocean U-point) 
    4237      jpjwd   =        1,   &  !: j-starting indice of the West open boundary (must be land T-point) 
    4338      jpjwf   =   jpjglo,   &  !: j-ending   indice of the West open boundary (must be land T-point) 
     39 
    4440      jpjwdp1 =  jpjwd+1,    &  !: first ocean point         "                 " 
    4541      jpjwfm1 =  jpjwf-1        !: last  ocean point         "                 " 
    … …  
    4844   LOGICAL, PARAMETER ::     &  !: 
    4945      lp_obc_north = .TRUE.     !: 
     46   INTEGER, PARAMETER ::     &  !: 
    5047 
    51      INTEGER   & 
    52 #if !defined key_agrif 
    53      , PARAMETER   &  
    54 #endif 
    55     ::     &  
    5648      ! * default values * 
    5749      !jpjnob = jpjglo-2,    &  !: j-localization of the North open boundary (must be ocean V-point) 
    5850      !jpind  =        2,    &  !: i-starting indice of the North open boundary (must be land T-point) 
    5951      !jpinf  = jpiglo-1,    &  !: i-ending   indice of the North open boundary (must be land T-point) 
     52 
    6053      jpjnob = jpjglo-2,    &  !: j-localization of the North open boundary (must be ocean V-point) 
    6154      jpind  =        1,    &  !: i-starting indice of the North open boundary (must be land T-point) 
    6255      jpinf  =   jpiglo,    &  !: i-ending   indice of the North open boundary (must be land T-point) 
     56 
    6357      jpindp1 =  jpind+1,    &  !: first ocean point         "                 " 
    6458      jpinfm1 =  jpinf-1        !: last  ocean point         "                 " 
    … …  
    6761   LOGICAL, PARAMETER ::     &  !: 
    6862      lp_obc_south = .TRUE.     !: INDICE to active or not the South open boundary 
     63   INTEGER, PARAMETER ::     &  !: 
    6964 
    70      INTEGER   & 
    71 #if !defined key_agrif 
    72      , PARAMETER   &  
    73 #endif 
    74     ::     &  
    7565      ! * default values * 
    7666      !jpjsob =        2,    &  !: j-localization of the South open boundary (must be ocean V-point) 
    7767      !jpisd  =        2,    &  !: i-starting indice of the South open boundary (must be land T-point) 
    7868      !jpisf  = jpiglo-1,    &  !: i-ending   indice of the South open boundary (must be land T-point) 
     69 
    7970      jpjsob =        2,    &  !: j-localization of the South open boundary (must be ocean V-point) 
    8071      jpisd  =        1,    &  !: i-starting indice of the South open boundary (must be land T-point) 
    8172      jpisf  =   jpiglo,    &  !: i-ending   indice of the South open boundary (must be land T-point) 
     73 
    8274      jpisdp1 =  jpisd+1,    &  !: first ocean point         "                 " 
    8375      jpisfm1 =  jpisf-1        !: last  ocean point         "                 " 

  • branches/devmercator2010/NEMO/OPA_SRC/OBC/obcdta.F90

    r2031 r2071  
    3030 
    3131  !! * Shared module variables 
    32 !$AGRIF_DO_NOT_TREAT 
    3332  REAL(wp),  DIMENSION(2)              ::  zjcnes_obc   !  
    3433  REAL(wp),  DIMENSION(:), ALLOCATABLE :: ztcobc 
    35 !$AGRIF_END_DO_NOT_TREAT 
    3634  REAL(wp) :: rdt_obc 
    3735  REAL(wp) :: zjcnes 

  • branches/devmercator2010/NEMO/OPA_SRC/OBC/obcfla.F90

    r2064 r2071  
    7878      !!------------------------------------------------------------------------------ 
    7979      !! * Local declaration 
    80       INTEGER ::   ji, jj ! dummy loop indices 
     80      INTEGER ::   ji, jj, jk ! dummy loop indices 
    8181      !!------------------------------------------------------------------------------ 
    8282 
    8383      DO ji = nie0, nie1 
    84          DO jj = 1, jpj 
    85             ua_e(ji,jj) = (  ubtfoe(jj) * hur(ji,jj) + sqrt( grav*hur(ji,jj) )   & 
    86                &            * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5        & 
    87                &            - sshfoe(jj) )  ) * uemsk(jj,1) 
     84         DO jk = 1, jpkm1 
     85            DO jj = 1, jpj 
     86               ua_e(ji,jj) = (  ubtfoe(jj) + sqrt( grav*hu(ji,jj) )           & 
     87                  &            * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5  & 
     88                  &            - sshfoe(jj) )  ) * uemsk(jj,jk) 
     89            END DO 
    8890         END DO 
    8991      END DO 
    … …  
    9597            ssha_e(ji,jj) = ssha_e(ji,jj) * ( 1. - temsk(jj,1) ) & 
    9698               &            + temsk(jj,1) * sshfoe(jj) 
    97             va_e(ji,jj) = vbtfoe(jj) * hvr(ji,jj) * uemsk(jj,1) 
     99            va_e(ji,jj) = vbtfoe(jj) * uemsk(jj,jk) 
    98100         END DO 
    99101      END DO 
    … …  
    114116      !!------------------------------------------------------------------------------ 
    115117      !! * Local declaration 
    116       INTEGER ::   ji, jj ! dummy loop indices 
     118      INTEGER ::   ji, jj, jk ! dummy loop indices 
    117119      !!------------------------------------------------------------------------------ 
    118120 
    119121      DO ji = niw0, niw1 
    120          DO jj = 1, jpj 
    121             ua_e(ji,jj) = ( ubtfow(jj) * hur(ji,jj) - sqrt( grav * hur(ji,jj) )   & 
    122                &            * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5         & 
    123                &                - sshfow(jj) ) ) * uwmsk(jj,1) 
    124             va_e(ji,jj) = vbtfow(jj) * hvr(ji,jj) * uwmsk(jj,1) 
     122         DO jk = 1, jpkm1 
     123            DO jj = 1, jpj 
     124               ua_e(ji,jj) = ( ubtfow(jj) - sqrt( grav * hu(ji,jj) )          & 
     125                  &            * ( ( sshn_e(ji,jj) + sshn_e(ji+1,jj) ) * 0.5  & 
     126                  &                - sshfow(jj) ) ) * uwmsk(jj,jk) 
     127               va_e(ji,jj) = vbtfow(jj) * uwmsk(jj,jk) 
     128            END DO 
    125129         END DO 
    126130         DO jj = 1, jpj 
    … …  
    147151      !!------------------------------------------------------------------------------ 
    148152      !! * Local declaration 
    149       INTEGER ::   ji, jj ! dummy loop indices 
     153      INTEGER ::   ji, jj, jk ! dummy loop indices 
    150154      !!------------------------------------------------------------------------------ 
    151155 
    152156      DO jj = njn0, njn1 
    153          DO ji = 1, jpi 
    154             va_e(ji,jj) = ( vbtfon(ji) * hvr(ji,jj) + sqrt( grav * hvr(ji,jj) )   & 
    155                &            * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5         & 
    156                &                - sshfon(ji) ) ) * vnmsk(ji,1) 
     157         DO jk = 1, jpkm1 
     158            DO ji = 1, jpi 
     159               va_e(ji,jj) = ( vbtfon(ji) + sqrt( grav * hv(ji,jj) )           & 
     160                  &            * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5   & 
     161                  &                - sshfon(ji) ) ) * vnmsk(ji,jk) 
     162            END DO 
    157163         END DO 
    158164      END DO 
    … …  
    164170            ssha_e(ji,jj) = ssha_e(ji,jj) * ( 1. - tnmsk(ji,1) ) & 
    165171               &            + sshfon(ji) * tnmsk(ji,1) 
    166             ua_e(ji,jj) = ubtfon(ji) * hur(ji,jj) * vnmsk(ji,1) 
     172            ua_e(ji,jj) = ubtfon(ji) * vnmsk(ji,jk) 
    167173         END DO 
    168174      END DO 
    … …  
    182188      !!------------------------------------------------------------------------------ 
    183189      !! * Local declaration 
    184       INTEGER ::   ji, jj ! dummy loop indices 
     190      INTEGER ::   ji, jj, jk ! dummy loop indices 
    185191 
    186192      !!------------------------------------------------------------------------------ 
    187193 
    188194      DO jj = njs0, njs1 
    189          DO ji = 1, jpi 
    190             va_e(ji,jj) = ( vbtfos(ji) * hvr(ji,jj) - sqrt( grav * hvr(ji,jj) )   & 
    191                &            * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5         & 
    192                &                - sshfos(ji) ) ) * vsmsk(ji,1) 
    193             ua_e(ji,jj) = ubtfos(ji) * hur(ji,jj) * vsmsk(ji,1) 
     195         DO jk = 1, jpkm1 
     196            DO ji = 1, jpi 
     197               va_e(ji,jj) = ( vbtfos(ji) - sqrt( grav * hv(ji,jj) )            & 
     198                  &            * ( ( sshn_e(ji,jj) + sshn_e(ji,jj+1) ) * 0.5    & 
     199                  &                - sshfos(ji) ) ) * vsmsk(ji,jk) 
     200               ua_e(ji,jj) = ubtfos(ji) * vsmsk(ji,jk) 
     201            END DO 
    194202         END DO 
    195203         DO ji = 1, jpi 

  • branches/devmercator2010/NEMO/OPA_SRC/OBC/obcini.F90

    r2065 r2071  
    6262      NAMELIST/namobc/ rn_dpein, rn_dpwin, rn_dpnin, rn_dpsin,       & 
    6363         &             rn_dpeob, rn_dpwob, rn_dpnob, rn_dpsob,       & 
    64          &             rn_volemp, nn_obcdta, cn_obcdta,    & 
     64         &             rn_volemp, nn_obcdta, cn_obcdta, rn_volemp,   & 
    6565         &             ln_obc_clim, ln_vol_cst, ln_obc_fla 
    6666      !!---------------------------------------------------------------------- 
    … …  
    7070 
    7171      ! convert DOCTOR namelist name into the OLD names 
     72      nbobc    = nn_nbobc 
    7273      nobc_dta = nn_obcdta 
    7374      cffile   = cn_obcdta 
    … …  
    100101      IF(lwp) WRITE(numout,*) 'obc_init : initialization of open boundaries' 
    101102      IF(lwp) WRITE(numout,*) '~~~~~~~~' 
    102       IF(lwp) WRITE(numout,*) '   Number of open boundaries    nbobc = ', nbobc 
     103      IF(lwp) WRITE(numout,*) '   Number of open boundaries    nn_nbobc = ', nn_nbobc 
    103104      IF(lwp) WRITE(numout,*) 
    104105 
    … …  
    149150      ENDIF 
    150151 
    151       IF( nbobc >= 2 .AND. jperio /= 0 )   & 
     152      IF( nbobc /= 0 .AND. jperio /= 0 )   & 
    152153         &   CALL ctl_stop( ' Cyclic or symmetric, and open boundary condition are not compatible' ) 
    153154 
    … …  
    305306      IF( lp_obc_east ) THEN 
    306307         !... (jpjed,jpjefm1),jpieob 
    307          bmask(nie0p1:nie1p1,nje0:nje1m1) = 0.e0 
    308308 
    309309         ! ... initilization to zero 
    … …  
    341341      IF( lp_obc_north ) THEN 
    342342         ! ... jpjnob,(jpind,jpisfm1) 
    343          bmask(nin0:nin1m1,njn0p1:njn1p1) = 0.e0 
    344343 
    345344         ! ... initilization to zero 
    … …  
    441440            END DO 
    442441         END IF 
     442   
    443443         IF( lp_obc_north ) THEN ! ... North open boundary lateral surface 
    444444            DO jj = njn0, njn1 

  • branches/devmercator2010/NEMO/OPA_SRC/OBC/obcrst.F90

    r1818 r2071  
    9696         ! ------------- 
    9797 
    98          CALL ctl_opn( inum, 'restart.obc.output', 'UNKNOWN', 'UNFORMATTED', 'DIRECT', nreclo, numout, lwp ) 
     98         CALL ctl_opn( inum, 'restart.obc.output', 'REPLACE', 'UNFORMATTED', 'DIRECT', nreclo, numout, lwp ) 
    9999  
    100100         ! 1.2 Write header 
    … …  
    322322      ! 0.1 Open files 
    323323      ! --------------- 
    324       CALL ctl_opn( inum, 'restart.obc', 'UNKNOWN', 'UNFORMATTED', 'DIRECT', nreclo, numout, lwp ) 
     324      CALL ctl_opn( inum, 'restart.obc', 'REPLACE', 'UNFORMATTED', 'DIRECT', nreclo, numout, lwp ) 
    325325 
    326326      ! 1. Read 

  • branches/devmercator2010/NEMO/OPA_SRC/OBC/obctra.F90

    r2028 r2071  
    490490                  zin = sign( 1., -1.* z05cx ) 
    491491                  zin = 0.5*( zin + abs(zin) ) 
    492                   ztau = (1.-zin ) * rtausin + zin * rtaus 
     492                  ztau = (1.-zin ) + zin * rtaus 
    493493                  z05cx = z05cx * zin 
    494  
    495494         !... update (ta,sa) with radiative or climatological (t, s) 
    496495                  ta(ji,jj,jk) = ta(ji,jj,jk) * (1.-tsmsk(ji,jk)) +             & 

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

    r1955 r2071  
    4848      INTEGER , DIMENSION(2)          ::   nrec_b       ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year) 
    4949      INTEGER , DIMENSION(2)          ::   nrec_a       ! after  record (1: index, 2: second since Jan. 1st 00h of nit000 year) 
    50       REAL(wp) , ALLOCATABLE, DIMENSION(:,:)   ::   fnow         ! input fields interpolated to now time step 
    51       REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:) ::   fdta         ! 2 consecutive record of input fields 
     50      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:)   ::   fnow       ! input fields interpolated to now time step 
     51      REAL(wp) , ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta       ! 2 consecutive record of input fields 
    5252      CHARACTER(len = 256)            ::   wgtname      ! current name of the NetCDF weight file acting as a key 
    5353                                                        ! into the WGTLIST structure 
    … …  
    7878      INTEGER, DIMENSION(:,:,:), POINTER      ::   data_jpj     ! array of source integers 
    7979      REAL(wp), DIMENSION(:,:,:), POINTER     ::   data_wgt     ! array of weights on model grid 
    80       REAL(wp), DIMENSION(:,:), POINTER       ::   fly_dta      ! array of values on input grid 
    81       REAL(wp), DIMENSION(:,:), POINTER       ::   col2         ! temporary array for reading in columns 
     80      REAL(wp), DIMENSION(:,:,:), POINTER     ::   fly_dta      ! array of values on input grid 
     81      REAL(wp), DIMENSION(:,:,:), POINTER     ::   col2         ! temporary array for reading in columns 
    8282   END TYPE WGT 
    8383 
    … …  
    120120 
    121121      INTEGER  ::   jf         ! dummy indices 
     122      INTEGER  ::   jk         ! dummy indices 
     123      INTEGER  ::   ipk        ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    122124      INTEGER  ::   kw         ! index into wgts array 
    123125      INTEGER  ::   ireclast   ! last record to be read in the current year file 
    … …  
    143145            IF( sd(jf)%ln_tint ) THEN         ! time interpolation: swap before record field 
    144146!CDIR COLLAPSE 
    145                sd(jf)%fdta(:,:,1) = sd(jf)%fdta(:,:,2) 
    146                sd(jf)%rotn(1)     = sd(jf)%rotn(2) 
     147               sd(jf)%fdta(:,:,:,1) = sd(jf)%fdta(:,:,:,2) 
     148               sd(jf)%rotn(1)       = sd(jf)%rotn(2) 
    147149            ENDIF 
    148150 
    … …  
    157159 
    158160               ! last record to be read in the current file 
    159                IF( sd(jf)%nfreqh == -1 ) THEN                  ;   ireclast = 12 
     161               IF( sd(jf)%nfreqh == -1 ) THEN 
     162                  IF(     sd(jf)%cltype == 'monthly'   ) THEN  ;   ireclast = 1 
     163                  ELSE                                         ;   ireclast = 12 
     164                  ENDIF 
    160165               ELSE                              
    161166                  IF(     sd(jf)%cltype == 'monthly'   ) THEN  ;   ireclast = 24 * nmonth_len(nmonth) / sd(jf)%nfreqh  
    … …  
    184189                        &                    nday   + 1                   - nmonth_len(nmonth) * COUNT((/llnxtmth/)), llstop ) 
    185190 
    186                      IF( sd(jf)%num <= 0 .AND. .NOT. llstop ) THEN    ! next year file does not exist 
     191                     IF( sd(jf)%num == 0 .AND. .NOT. llstop ) THEN    ! next year file does not exist 
    187192                        CALL ctl_warn('next year/month/day file: '//TRIM(sd(jf)%clname)//     & 
    188193                                &     ' not present -> back to current year/month/day') 
    … …  
    204209            IF( LEN(TRIM(sd(jf)%wgtname)) > 0 ) THEN 
    205210               CALL wgt_list( sd(jf), kw ) 
    206                CALL fld_interp( sd(jf)%num, sd(jf)%clvar, kw, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) ) 
     211               ipk =  SIZE(sd(jf)%fdta,3) 
     212               CALL fld_interp( sd(jf)%num, sd(jf)%clvar , kw , ipk, sd(jf)%fdta(:,:,:,2) , sd(jf)%nrec_a(1) ) 
    207213            ELSE 
    208                CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,2), sd(jf)%nrec_a(1) ) 
     214               SELECT CASE( SIZE(sd(jf)%fdta,3) ) 
     215               CASE(1) 
     216                  CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,1,2), sd(jf)%nrec_a(1) ) 
     217               CASE(jpk) 
     218                  CALL iom_get( sd(jf)%num, jpdom_data, sd(jf)%clvar, sd(jf)%fdta(:,:,:,2), sd(jf)%nrec_a(1) ) 
     219               END SELECT 
    209220            ENDIF 
    210221            sd(jf)%rotn(2) = .FALSE. 
    … …  
    245256                         utmp(:,:) = 0.0 
    246257                         vtmp(:,:) = 0.0 
    247                          CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->i', utmp(:,:) ) 
    248                          CALL rot_rep( sd(jf)%fdta(:,:,nf), sd(kf)%fdta(:,:,nf), 'T', 'en->j', vtmp(:,:) ) 
    249                          sd(jf)%fdta(:,:,nf) = utmp(:,:) 
    250                          sd(kf)%fdta(:,:,nf) = vtmp(:,:) 
     258                         ! 
     259                         ipk = SIZE( sd(kf)%fdta(:,:,:,nf) ,3 ) 
     260                         DO jk = 1,ipk 
     261                            CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->i', utmp(:,:) ) 
     262                            CALL rot_rep( sd(jf)%fdta(:,:,jk,nf),sd(kf)%fdta(:,:,jk,nf),'T', 'en->j', vtmp(:,:) ) 
     263                            sd(jf)%fdta(:,:,jk,nf) = utmp(:,:) 
     264                            sd(kf)%fdta(:,:,jk,nf) = vtmp(:,:) 
     265                         END DO 
     266                         ! 
    251267                         sd(jf)%rotn(nf) = .TRUE. 
    252268                         sd(kf)%rotn(nf) = .TRUE. 
    … …  
    280296               ztintb =  1. - ztinta 
    281297!CDIR COLLAPSE 
    282                sd(jf)%fnow(:,:) = ztintb * sd(jf)%fdta(:,:,1) + ztinta * sd(jf)%fdta(:,:,2) 
     298               sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2) 
    283299            ELSE 
    284300               IF(lwp .AND. kt - nit000 <= 100 ) THEN 
    … …  
    288304               ENDIF 
    289305!CDIR COLLAPSE 
    290                sd(jf)%fnow(:,:) = sd(jf)%fdta(:,:,2)   ! piecewise constant field 
     306               sd(jf)%fnow(:,:,:) = sd(jf)%fdta(:,:,:,2)   ! piecewise constant field 
    291307  
    292308            ENDIF 
    … …  
    320336      INTEGER :: inrec          ! number of record existing for this variable 
    321337      INTEGER :: kwgt 
     338      INTEGER :: jk             !vertical loop variable 
     339      INTEGER :: ipk            !number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    322340      CHARACTER(LEN=1000) ::   clfmt   ! write format 
    323341      !!--------------------------------------------------------------------- 
    … …  
    339357               IF( sdjf%cltype == 'monthly' ) THEN   ! monthly file 
    340358                  sdjf%nrec_b(1) = 1                                                       ! force to read the unique record 
    341                   llprevmth = .NOT. sdjf%ln_clim                                           ! use previous month file? 
     359                  llprevmth = .TRUE.                                                       ! use previous month file? 
    342360                  llprevyr  = llprevmth .AND. nmonth == 1                                  ! use previous year  file? 
    343361               ELSE                                  ! yearly file 
    … …  
    366384            &                  nmonth - COUNT((/llprevmth/)) + 12                   * COUNT((/llprevyr /)),               & 
    367385            &                  nday   - COUNT((/llprevday/)) + nmonth_len(nmonth-1) * COUNT((/llprevmth/)), .NOT. llprev ) 
    368           
     386 
    369387         ! if previous year/month/day file does not exist, we switch to the current year/month/day 
    370          IF( llprev .AND. sdjf%num <= 0 ) THEN 
     388         IF( llprev .AND. sdjf%num == 0 ) THEN 
    371389            CALL ctl_warn( 'previous year/month/day file: '//TRIM(sdjf%clname)//' not present -> back to current year/month/day') 
    372390            ! we force to read the first record of the current year/month/day instead of last record of previous year/month/day 
    … …  
    384402 
    385403         ! read before data into sdjf%fdta(:,:,2) because we will swap data in the following part of fld_read 
     404          
    386405         IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
    387406            CALL wgt_list( sdjf, kwgt ) 
    388             CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, sdjf%fdta(:,:,2), sdjf%nrec_b(1) ) 
     407            ipk = SIZE(sdjf%fdta,3) 
     408            CALL fld_interp( sdjf%num, sdjf%clvar, kwgt, ipk, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 
    389409         ELSE 
    390             CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,2), sdjf%nrec_b(1) ) 
     410            SELECT CASE ( SIZE(sdjf%fdta,3) ) 
     411            CASE(1) 
     412                CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_b(1) ) 
     413            CASE(jpk) 
     414                CALL iom_get( sdjf%num, jpdom_data, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_b(1) ) 
     415            END SELECT 
    391416         ENDIF 
    392417         sdjf%rotn(2) = .FALSE. 
    … …  
    399424      ENDIF 
    400425 
    401       IF( sdjf%num <= 0 )   CALL fld_clopn( sdjf, nyear, nmonth, nday )   ! make sure current year/month/day file is opened 
     426 
     427      IF( sdjf%num == 0 )   CALL fld_clopn( sdjf, nyear, nmonth, nday )   ! make sure current year/month/day file is opened 
    402428 
    403429      sdjf%nswap_sec = nsec_year + nsec1jan000 - 1   ! force read/update the after data in the following part of fld_read  
    404        
     430      
    405431   END SUBROUTINE fld_init 
    406432 
    … …  
    436462            !       forcing record :  nmonth  
    437463            !                             
    438             ztmp  = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 
     464            ztmp  = 0.e0 
     465            IF(  REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) .GT. 0.5 ) ztmp  = 1.0 
    439466         ELSE 
    440467            ztmp  = 0.e0 
    … …  
    446473         ENDIF 
    447474 
    448          sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define after  record number and time 
    449          irec = irec - 1                                                ! move back to previous record 
    450          sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define before record number and time 
     475         IF( sdjf%cltype == 'monthly' ) THEN 
     476 
     477            sdjf%nrec_b(:) = (/ 0, nmonth_half(irec - 1 ) + nsec1jan000 /) 
     478            sdjf%nrec_a(:) = (/ 1, nmonth_half(irec     ) + nsec1jan000 /) 
     479 
     480            IF( ztmp  == 1. ) THEN 
     481              sdjf%nrec_b(1) = 1 
     482              sdjf%nrec_a(1) = 2 
     483            ENDIF 
     484 
     485         ELSE 
     486 
     487            sdjf%nrec_a(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define after  record number and time 
     488            irec = irec - 1                                                ! move back to previous record 
     489            sdjf%nrec_b(:) = (/ irec, nmonth_half(irec) + nsec1jan000 /)   ! define before record number and time 
     490 
     491         ENDIF 
    451492         ! 
    452493      ELSE                              ! higher frequency mean (in hours) 
    … …  
    534575         IF( sdjf%cltype /= 'yearly' )    WRITE(sdjf%clname, '(a,"m" ,i2.2)' ) TRIM( sdjf%clname     ), kmonth   ! add month 
    535576         IF( sdjf%cltype == 'daily'  )    WRITE(sdjf%clname, '(a,"d" ,i2.2)' ) TRIM( sdjf%clname     ), kday     ! add day 
     577      ELSE 
     578         ! build the new filename if climatological data 
     579         IF( sdjf%cltype == 'monthly' )   WRITE(sdjf%clname, '(a,"_m" ,i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month 
    536580      ENDIF 
    537581      CALL iom_open( sdjf%clname, sdjf%num, ldstop = ldstop, ldiof =  LEN(TRIM(sdjf%wgtname)) > 0 ) 
    … …  
    564608         sdf(jf)%ln_tint    = sdf_n(jf)%ln_tint 
    565609         sdf(jf)%ln_clim    = sdf_n(jf)%ln_clim 
    566          IF( sdf(jf)%nfreqh == -1. ) THEN   ;   sdf(jf)%cltype = 'yearly' 
    567          ELSE                               ;   sdf(jf)%cltype = sdf_n(jf)%cltype 
    568          ENDIF 
     610         sdf(jf)%cltype     = sdf_n(jf)%cltype 
    569611         sdf(jf)%wgtname = " " 
    570612         IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 )   sdf(jf)%wgtname = TRIM( cdir )//TRIM( sdf_n(jf)%wname ) 
    … …  
    684726      INTEGER                                 ::   inum          ! temporary logical unit 
    685727      INTEGER                                 ::   id            ! temporary variable id 
     728      INTEGER                                 ::   ipk           ! temporary vertical dimension 
    686729      CHARACTER (len=5)                       ::   aname 
    687730      INTEGER , DIMENSION(3)                  ::   ddims 
    … …  
    815858            WRITE(aname,'(a3,i2.2)') 'src',jn 
    816859            data_tmp(:,:) = 0 
    817             CALL iom_get ( inum, jpdom_data, aname, data_tmp(:,:) ) 
     860            CALL iom_get ( inum, jpdom_unknown, aname, data_tmp(1:nlci,1:nlcj), & 
     861                           kstart=(/nimpp,njmpp/), kcount=(/nlci,nlcj/) ) 
    818862            data_src(:,:) = INT(data_tmp(:,:)) 
    819863            ref_wgts(nxt_wgt)%data_jpj(:,:,jn) = 1 + (data_src(:,:)-1) / ref_wgts(nxt_wgt)%ddims(1) 
    … …  
    824868            aname = ' ' 
    825869            WRITE(aname,'(a3,i2.2)') 'wgt',jn 
    826             ref_wgts(nxt_wgt)%data_wgt(:,:,jn) = 0.0 
    827             CALL iom_get ( inum, jpdom_data, aname, ref_wgts(nxt_wgt)%data_wgt(:,:,jn) ) 
     870            ref_wgts(nxt_wgt)%data_wgt(1:nlci,1:nlcj,jn) = 0.0 
     871            CALL iom_get ( inum, jpdom_unknown, aname, ref_wgts(nxt_wgt)%data_wgt(1:nlci,1:nlcj,jn), & 
     872                           kstart=(/nimpp,njmpp/), kcount=(/nlci,nlcj/) ) 
    828873         END DO 
    829874         CALL iom_close (inum) 
    830875  
    831876         ! find min and max indices in grid 
    832          ref_wgts(nxt_wgt)%botleft(1) = MINVAL(ref_wgts(nxt_wgt)%data_jpi(:,:,:)) 
    833          ref_wgts(nxt_wgt)%botleft(2) = MINVAL(ref_wgts(nxt_wgt)%data_jpj(:,:,:)) 
    834          ref_wgts(nxt_wgt)%topright(1) = MAXVAL(ref_wgts(nxt_wgt)%data_jpi(:,:,:)) 
    835          ref_wgts(nxt_wgt)%topright(2) = MAXVAL(ref_wgts(nxt_wgt)%data_jpj(:,:,:)) 
     877         ref_wgts(nxt_wgt)%botleft(1) = MINVAL(ref_wgts(nxt_wgt)%data_jpi(1:nlci,1:nlcj,:)) 
     878         ref_wgts(nxt_wgt)%botleft(2) = MINVAL(ref_wgts(nxt_wgt)%data_jpj(1:nlci,1:nlcj,:)) 
     879         ref_wgts(nxt_wgt)%topright(1) = MAXVAL(ref_wgts(nxt_wgt)%data_jpi(1:nlci,1:nlcj,:)) 
     880         ref_wgts(nxt_wgt)%topright(2) = MAXVAL(ref_wgts(nxt_wgt)%data_jpj(1:nlci,1:nlcj,:)) 
    836881 
    837882         ! and therefore dimensions of the input box 
    … …  
    846891         ! SA: +3 stencil is a patch to avoid out-of-bound computation in some configuration.  
    847892         ! a more robust solution will be given in next release 
    848          ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3) ) 
    849          IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col2(2,ref_wgts(nxt_wgt)%jpjwgt+3) ) 
     893         ipk =  SIZE(sd%fdta,3) 
     894         ALLOCATE( ref_wgts(nxt_wgt)%fly_dta(ref_wgts(nxt_wgt)%jpiwgt+3, ref_wgts(nxt_wgt)%jpjwgt+3 ,ipk) ) 
     895         IF( ref_wgts(nxt_wgt)%cyclic ) ALLOCATE( ref_wgts(nxt_wgt)%col2(2,ref_wgts(nxt_wgt)%jpjwgt+3,ipk) ) 
    850896 
    851897         nxt_wgt = nxt_wgt + 1 
    … …  
    857903   END SUBROUTINE fld_weight 
    858904 
    859    SUBROUTINE fld_interp(num, clvar, kw, dta, nrec) 
     905   SUBROUTINE fld_interp(num, clvar, kw, kk, dta, nrec) 
    860906      !!--------------------------------------------------------------------- 
    861907      !!                    ***  ROUTINE fld_interp  *** 
    … …  
    866912      !! ** Method  :    
    867913      !!---------------------------------------------------------------------- 
    868       INTEGER,          INTENT(in)                        ::   num                 ! stream number 
    869       CHARACTER(LEN=*), INTENT(in)                        ::   clvar               ! variable name 
    870       INTEGER,          INTENT(in)                        ::   kw                  ! weights number 
    871       REAL(wp),         INTENT(inout), DIMENSION(jpi,jpj) ::   dta                 ! output field on model grid 
    872       INTEGER,          INTENT(in)                        ::   nrec                ! record number to read (ie time slice) 
     914      INTEGER,          INTENT(in)                           ::   num                 ! stream number 
     915      CHARACTER(LEN=*), INTENT(in)                           ::   clvar               ! variable name 
     916      INTEGER,          INTENT(in)                           ::   kw                  ! weights number 
     917      INTEGER,          INTENT(in)                           ::   kk                  ! vertical dimension of kk 
     918      REAL(wp),         INTENT(inout), DIMENSION(jpi,jpj,kk) ::   dta                 ! output field on model grid 
     919      INTEGER,          INTENT(in)                           ::   nrec                ! record number to read (ie time slice) 
    873920      !!  
    874       INTEGER, DIMENSION(2)                               ::   rec1,recn           ! temporary arrays for start and length 
    875       INTEGER                                             ::  jk, jn, jm           ! loop counters 
    876       INTEGER                                             ::  ni, nj               ! lengths 
    877       INTEGER                                             ::  jpimin,jpiwid        ! temporary indices 
    878       INTEGER                                             ::  jpjmin,jpjwid        ! temporary indices 
    879       INTEGER                                             ::  jpi1,jpi2,jpj1,jpj2  ! temporary indices 
     921      INTEGER, DIMENSION(3)                                  ::   rec1,recn           ! temporary arrays for start and length 
     922      INTEGER                                                ::  jk, jn, jm           ! loop counters 
     923      INTEGER                                                ::  ni, nj               ! lengths 
     924      INTEGER                                                ::  jpimin,jpiwid        ! temporary indices 
     925      INTEGER                                                ::  jpjmin,jpjwid        ! temporary indices 
     926      INTEGER                                                ::  jpi1,jpi2,jpj1,jpj2  ! temporary indices 
    880927      !!---------------------------------------------------------------------- 
    881928      ! 
    … …  
    895942      rec1(1) = MAX( jpimin-1, 1 ) 
    896943      rec1(2) = MAX( jpjmin-1, 1 ) 
     944      rec1(3) = 1 
    897945      recn(1) = MIN( jpiwid+2, ref_wgts(kw)%ddims(1)-rec1(1)+1 ) 
    898946      recn(2) = MIN( jpjwid+2, ref_wgts(kw)%ddims(2)-rec1(2)+1 ) 
     947      recn(3) = kk 
    899948 
    900949      !! where we need to read it to 
    … …  
    904953      jpj2 = jpj1 + recn(2) - 1 
    905954 
    906       ref_wgts(kw)%fly_dta(:,:) = 0.0 
    907       CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2), nrec, rec1, recn) 
     955      ref_wgts(kw)%fly_dta(:,:,:) = 0.0 
     956      SELECT CASE( SIZE(ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:),3) ) 
     957      CASE(1) 
     958           CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,1), nrec, rec1, recn) 
     959      CASE(jpk)   
     960           CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn) 
     961      END SELECT  
    908962 
    909963      !! first four weights common to both bilinear and bicubic 
    910964      !! note that we have to offset by 1 into fly_dta array because of halo 
    911       dta(:,:) = 0.0 
     965      dta(:,:,:) = 0.0 
    912966      DO jk = 1,4 
    913         DO jn = 1, jpj 
    914           DO jm = 1,jpi 
     967        DO jn = 1, nlcj 
     968          DO jm = 1,nlci 
    915969            ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    916970            nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    917             dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1) 
     971            dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1,jk) 
    918972          END DO 
    919973        END DO 
    … …  
    924978        !! fix up halo points that we couldnt read from file 
    925979        IF( jpi1 == 2 ) THEN 
    926            ref_wgts(kw)%fly_dta(jpi1-1,:) = ref_wgts(kw)%fly_dta(jpi1,:) 
     980           ref_wgts(kw)%fly_dta(jpi1-1,:,:) = ref_wgts(kw)%fly_dta(jpi1,:,:) 
    927981        ENDIF 
    928982        IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 
    929            ref_wgts(kw)%fly_dta(jpi2+1,:) = ref_wgts(kw)%fly_dta(jpi2,:) 
     983           ref_wgts(kw)%fly_dta(jpi2+1,:,:) = ref_wgts(kw)%fly_dta(jpi2,:,:) 
    930984        ENDIF 
    931985        IF( jpj1 == 2 ) THEN 
    932            ref_wgts(kw)%fly_dta(:,jpj1-1) = ref_wgts(kw)%fly_dta(:,jpj1) 
     986           ref_wgts(kw)%fly_dta(:,jpj1-1,:) = ref_wgts(kw)%fly_dta(:,jpj1,:) 
    933987        ENDIF 
    934988        IF( jpj2 + jpjmin - 1 == ref_wgts(kw)%ddims(2)+1 .AND. jpj2 .lt. jpjwid+2 ) THEN 
    935            ref_wgts(kw)%fly_dta(:,jpj2+1) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2) - ref_wgts(kw)%fly_dta(:,jpj2-1) 
     989           ref_wgts(kw)%fly_dta(:,jpj2+1,:) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2,:) - ref_wgts(kw)%fly_dta(:,jpj2-1,:) 
    936990        ENDIF 
    937991 
    … …  
    9461000           IF( jpi1 == 2 ) THEN 
    9471001              rec1(1) = ref_wgts(kw)%ddims(1) - 1 
    948               CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn) 
    949               ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2) = ref_wgts(kw)%col2(ref_wgts(kw)%offset+1,jpj1:jpj2) 
     1002              SELECT CASE( SIZE( ref_wgts(kw)%col2(:,jpj1:jpj2,:),3) ) 
     1003              CASE(1) 
     1004                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,1), nrec, rec1, recn) 
     1005              CASE(jpk)          
     1006                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,:), nrec, rec1, recn) 
     1007              END SELECT       
     1008              ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col2(ref_wgts(kw)%offset+1,jpj1:jpj2,:) 
    9501009           ENDIF 
    9511010           IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 
    9521011              rec1(1) = 1 
    953               CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2), nrec, rec1, recn) 
    954               ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2) = ref_wgts(kw)%col2(2-ref_wgts(kw)%offset,jpj1:jpj2) 
     1012              SELECT CASE( SIZE( ref_wgts(kw)%col2(:,jpj1:jpj2,:),3) ) 
     1013              CASE(1) 
     1014                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,1), nrec, rec1, recn) 
     1015              CASE(jpk) 
     1016                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col2(:,jpj1:jpj2,:), nrec, rec1, recn) 
     1017              END SELECT 
     1018              ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col2(2-ref_wgts(kw)%offset,jpj1:jpj2,:) 
    9551019           ENDIF 
    9561020        ENDIF 
    … …  
    9581022        ! gradient in the i direction 
    9591023        DO jk = 1,4 
    960           DO jn = 1, jpj 
    961             DO jm = 1,jpi 
     1024          DO jn = 1, nlcj 
     1025            DO jm = 1,nlci 
    9621026              ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    9631027              nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    964               dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 *         & 
    965                                (ref_wgts(kw)%fly_dta(ni+2,nj+1) - ref_wgts(kw)%fly_dta(ni,nj+1)) 
     1028              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 *         & 
     1029                               (ref_wgts(kw)%fly_dta(ni+2,nj+1,:) - ref_wgts(kw)%fly_dta(ni,nj+1,:)) 
    9661030            END DO 
    9671031          END DO 
    … …  
    9701034        ! gradient in the j direction 
    9711035        DO jk = 1,4 
    972           DO jn = 1, jpj 
    973             DO jm = 1,jpi 
     1036          DO jn = 1, nlcj 
     1037            DO jm = 1,nlci 
    9741038              ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    9751039              nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    976               dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 *         & 
    977                                (ref_wgts(kw)%fly_dta(ni+1,nj+2) - ref_wgts(kw)%fly_dta(ni+1,nj)) 
     1040              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 *         & 
     1041                               (ref_wgts(kw)%fly_dta(ni+1,nj+2,:) - ref_wgts(kw)%fly_dta(ni+1,nj,:)) 
    9781042            END DO 
    9791043          END DO 
    … …  
    9861050              ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    9871051              nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    988               dta(jm,jn) = dta(jm,jn) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( & 
    989                                (ref_wgts(kw)%fly_dta(ni+2,nj+2) - ref_wgts(kw)%fly_dta(ni  ,nj+2)) -   & 
    990                                (ref_wgts(kw)%fly_dta(ni+2,nj  ) - ref_wgts(kw)%fly_dta(ni  ,nj  ))) 
     1052              dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( & 
     1053                               (ref_wgts(kw)%fly_dta(ni+2,nj+2,:) - ref_wgts(kw)%fly_dta(ni  ,nj+2,:)) -   & 
     1054                               (ref_wgts(kw)%fly_dta(ni+2,nj  ,:) - ref_wgts(kw)%fly_dta(ni  ,nj  ,:))) 
    9911055            END DO 
    9921056          END DO 

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

    r1833 r2071  
    311311 
    312312      ! lateral boundary cond.: T-, U-, V-, F-pts, sgn 
    313       CALL lbc_lnk( gcost, 'T', -1. )   ;   CALL lbc_lnk( gsint, 'T', -1. ) 
    314       CALL lbc_lnk( gcosu, 'U', -1. )   ;   CALL lbc_lnk( gsinu, 'U', -1. ) 
    315       CALL lbc_lnk( gcosv, 'V', -1. )   ;   CALL lbc_lnk( gsinv, 'V', -1. ) 
    316       CALL lbc_lnk( gcosf, 'F', -1. )   ;   CALL lbc_lnk( gsinf, 'F', -1. ) 
     313      CALL lbc_lnk( gcost, 'T', 1. )   ;   CALL lbc_lnk( gsint, 'T', -1. ) 
     314      CALL lbc_lnk( gcosu, 'U', 1. )   ;   CALL lbc_lnk( gsinu, 'U', -1. ) 
     315      CALL lbc_lnk( gcosv, 'V', 1. )   ;   CALL lbc_lnk( gsinv, 'V', -1. ) 
     316      CALL lbc_lnk( gcosf, 'F', 1. )   ;   CALL lbc_lnk( gsinf, 'F', -1. ) 
    317317 
    318318   END SUBROUTINE angle 

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

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

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

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

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

    r2044 r2071  
    2323   USE sbc_oce         ! Surface boundary condition: ocean fields 
    2424   USE sbc_ice         ! Surface boundary condition: ice fields 
    25    USE phycst          ! physical constants 
    2625#if defined key_lim3 
    2726   USE par_ice         ! ice parameters 
    … …  
    4039   USE restart         ! 
    4140   USE oce   , ONLY : tn, un, vn 
     41   USE phycst, ONLY : rt0, rcp 
    4242   USE albedo          ! 
    4343   USE in_out_manager  ! I/O manager 
    … …  
    4545   USE lib_mpp         ! distribued memory computing library 
    4646   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
     47   USE phycst, ONLY : xlsn, rhosn, xlic, rhoic 
    4748#if defined key_cpl_carbon_cycle 
    4849   USE p4zflx, ONLY : oce_co2 
    … …  
    273274      srcv(jpr_itz2)%clname = 'O_ITauz2'      ! 3rd   -      -         -     -  
    274275      !  
    275       ! Vectors: change of sign at north fold ONLY if on the local grid 
    276       IF( TRIM( cn_rcv_tau(3) ) == 'local grid' )   srcv(jpr_otx1:jpr_itz2)%nsgn = -1. 
     276      srcv(jpr_otx1:jpr_itz2)%nsgn = -1                           ! Vectors: change of sign at north fold 
    277277       
    278278      !                                                           ! Set grid and action 
    … …  
    714714         IF( srcv(jpr_qnsoce)%laction )   qns(:,:) = frcv(:,:,jpr_qnsoce) 
    715715         IF( srcv(jpr_qnsmix)%laction )   qns(:,:) = frcv(:,:,jpr_qnsmix)         
    716          qns(:,:) = qns(:,:) - frcv(:,:,jpr_snow) * lfus              ! add the latent heat of solid precip. melting  
    717  
     716         !   energy for melting solid precipitation over free ocean 
     717         zcoef = xlsn / rhosn 
     718         qns(:,:) = qns(:,:) - frcv(:,:,jpr_snow) * zcoef 
    718719         !                                                       ! solar flux over the ocean          (qsr) 
    719720         IF( srcv(jpr_qsroce)%laction )   qsr(:,:) = frcv(:,:,jpr_qsroce)  
    … …  
    11161117            &                                                   +          pist(:,:,1)   * zicefr(:,:,1) ) ) 
    11171118      END SELECT 
    1118       ztmp(:,:) = p_frld(:,:,1) * zsnow(:,:) * lfus               ! add the latent heat of solid precip. melting 
    1119       pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:)                   ! over free ocean  
     1119      !                                                           ! snow melting heat flux .... 
     1120      !   energy for melting solid precipitation over ice-free ocean 
     1121      zcoef = xlsn / rhosn 
     1122      ztmp(:,:) = p_frld(:,:,1) * zsnow(:,:) * zcoef 
     1123      pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:) 
    11201124      IF( lk_diaar5 )   CALL iom_put( 'hflx_snow_cea', ztmp + zsnow(:,:) * zcptn(:,:) )   ! heat flux from snow (cell average) 
    11211125!!gm 
    … …  
    11261130!! 
    11271131!! similar job should be done for snow and precipitation temperature 
    1128       !                                      
    1129       IF( srcv(jpr_cal)%laction ) THEN                            ! Iceberg melting  
    1130          ztmp(:,:) = frcv(:,:,jpr_cal) * lfus                     ! add the latent heat of iceberg melting  
     1132      !                                                           ! Iceberg melting heat flux .... 
     1133      !   energy for iceberg melting  
     1134      IF( srcv(jpr_cal)%laction ) THEN  
     1135         zcoef = xlic / rhoic 
     1136         ztmp(:,:) = frcv(:,:,jpr_cal) * zcoef 
    11311137         pqns_tot(:,:) = pqns_tot(:,:) - ztmp(:,:) 
    11321138         IF( lk_diaar5 )   CALL iom_put( 'hflx_cal_cea', ztmp + frcv(:,:,jpr_cal) * zcptn(:,:) )   ! heat flux from calving 

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

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

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

    r1822 r2071  
    6565      INTEGER  ::   inum                  ! temporary logical unit 
    6666      INTEGER  ::   ikty, iyear           !  
    67       REAL(wp) ::   z_emp, z_emp_nsrf, zsum_emp, zsum_erp       ! temporary scalars 
     67      REAL(wp) ::   z_emp, z_emp_nsrf       ! temporary scalars 
    6868      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread 
    6969      REAL(wp), DIMENSION(jpi,jpj) ::   ztmsk_neg, ztmsk_pos, ztmsk_tospread 
    … …  
    165165            ! 
    166166            IF( lk_mpp )   CALL  mpp_sum( z_emp ) 
    167             IF( lk_mpp )   CALL  mpp_sum( zsurf_neg ) 
    168             IF( lk_mpp )   CALL  mpp_sum( zsurf_pos ) 
    169167             
    170168            IF( z_emp < 0.e0 ) THEN 
    … …  
    179177 
    180178            ! emp global mean over <0 or >0 erp area 
    181             zsum_emp = SUM( e1e2_i(:,:) * z_emp ) 
    182             IF( lk_mpp )   CALL  mpp_sum( zsum_emp ) 
    183             z_emp_nsrf =  zsum_emp / ( zsurf_tospread + rsmall ) 
     179            z_emp_nsrf = SUM( e1e2_i(:,:) * z_emp ) / ( zsurf_tospread + rsmall ) 
    184180            ! weight to respect erp field 2D structure  
    185             zsum_erp = SUM( ztmsk_tospread(:,:) * erp(:,:) * e1e2_i(:,:) ) 
    186             IF( lk_mpp )   CALL  mpp_sum( zsum_erp ) 
    187             z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( zsum_erp + rsmall ) 
    188  
     181            z_wgt(:,:) = ztmsk_tospread(:,:) * erp(:,:) / ( SUM( ztmsk_tospread(:,:) * erp(:,:) * e1e2_i(:,:) ) + rsmall ) 
    189182            ! final correction term to apply 
    190183            zerp_cor(:,:) = -1. * z_emp_nsrf * zsurf_tospread * z_wgt(:,:) 

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

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

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

    r1792 r2071  
    8585!!gm here no overwrite, test all option via namelist change: require more incore memory 
    8686!!gm  IF( lk_sbc_cpl       ) THEN   ;   ln_cpl      = .TRUE.   ;   ELSE   ;   ln_cpl      = .FALSE.   ;   ENDIF 
    87  
     87#if defined key_agrif 
    8888      IF ( Agrif_Root() ) THEN 
     89#endif 
    8990        IF( lk_lim2 )            nn_ice      = 2 
    9091        IF( lk_lim3 )            nn_ice      = 3 
    91       ENDIF 
    92       ! 
     92#if defined key_agrif 
     93      ENDIF 
     94#endif 
    9395      IF( cp_cfg == 'gyre' ) THEN 
    9496          ln_ana      = .TRUE.    

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

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

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

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

  • branches/devmercator2010/NEMO/OPA_SRC/SOL/solmat.F90

    r2031 r2071  
    8080      ENDIF 
    8181 
    82 #if defined key_dynspg_flt  
    83 #   if ! defined key_obc 
     82#if defined key_dynspg_flt && ! defined key_obc 
    8483 
    8584      DO jj = 2, jpjm1                      ! matrix of free surface elliptic system 
    … …  
    9897         END DO 
    9998      END DO 
    100 #   else 
    101     IF ( Agrif_Root() ) THEN 
     99       
     100#  elif defined key_dynspg_flt && defined key_obc 
     101 
    102102      DO jj = 2, jpjm1                      ! matrix of free surface elliptic system with open boundaries 
    103103         DO ji = 2, jpim1 
    … …  
    140140         END DO 
    141141      END DO 
    142     ELSE 
    143       DO jj = 2, jpjm1                      ! matrix of free surface elliptic system 
    144          DO ji = 2, jpim1 
    145             zcoef = z2dt * z2dt * grav * bmask(ji,jj) 
    146             zcoefs = -zcoef * hv(ji  ,jj-1) * e1v(ji  ,jj-1) / e2v(ji  ,jj-1)    ! south coefficient 
    147             zcoefw = -zcoef * hu(ji-1,jj  ) * e2u(ji-1,jj  ) / e1u(ji-1,jj  )    ! west coefficient 
    148             zcoefe = -zcoef * hu(ji  ,jj  ) * e2u(ji  ,jj  ) / e1u(ji  ,jj  )    ! east coefficient 
    149             zcoefn = -zcoef * hv(ji  ,jj  ) * e1v(ji  ,jj  ) / e2v(ji  ,jj  )    ! north coefficient 
    150             gcp(ji,jj,1) = zcoefs 
    151             gcp(ji,jj,2) = zcoefw 
    152             gcp(ji,jj,3) = zcoefe 
    153             gcp(ji,jj,4) = zcoefn 
    154             gcdmat(ji,jj) = e1t(ji,jj) * e2t(ji,jj) * bmask(ji,jj)    &          ! diagonal coefficient 
    155                &          - zcoefs -zcoefw -zcoefe -zcoefn 
    156          END DO 
    157       END DO 
    158     ENDIF 
    159 #   endif 
    160142#endif 
    161143 
    162       IF( .NOT. Agrif_Root() ) THEN 
     144#if defined key_agrif 
     145      IF( .NOT.AGRIF_ROOT() ) THEN 
    163146         ! 
    164147         IF( nbondi == -1 .OR. nbondi == 2 )   bmask(2     ,:     ) = 0.e0 
    … …  
    209192         !  
    210193      ENDIF 
     194#endif 
    211195 
    212196      ! 2. Boundary conditions  

  • branches/devmercator2010/NEMO/OPA_SRC/TRA/traadv_tvd.F90

    r1877 r2071  
    179179      END DO 
    180180 
    181       ! "zonal" mean advective heat and salt transport 
    182       IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    183          pht_adv(:) = ptr_vj( ztv(:,:,:) ) 
    184          pst_adv(:) = ptr_vj( zsv(:,:,:) ) 
    185       ENDIF 
    186181 
    187182      ! Save the intermediate i / j / k advective trends for diagnostics 
    … …  
    371366      ! "zonal" mean advective heat and salt transport 
    372367      IF( ln_diaptr .AND. ( MOD( kt, nf_ptr ) == 0 ) ) THEN 
    373          pht_adv(:) = ptr_vj( ztv(:,:,:) ) + pht_adv(:) 
    374          pst_adv(:) = ptr_vj( zsv(:,:,:) ) + pst_adv(:) 
     368         pht_adv(:) = ptr_vj( ztv(:,:,:) ) 
     369         pst_adv(:) = ptr_vj( zsv(:,:,:) ) 
    375370      ENDIF 
    376371      ! 

  • branches/devmercator2010/NEMO/OPA_SRC/TRA/tranxt.F90

    r1876 r2071  
    3838   USE agrif_opa_update 
    3939   USE agrif_opa_interp 
    40    USE obc_oce  
    4140 
    4241   IMPLICIT NONE 
    … …  
    102101      ! 
    103102#if defined key_obc 
    104       IF( lk_obc )   CALL obc_tra( kt )  ! OBC open boundaries 
     103      CALL obc_tra( kt )               ! OBC open boundaries 
    105104#endif 
    106105#if defined key_bdy 

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

    r2031 r2071  
    4545    
    4646   ! Module variables 
    47 !$AGRIF_DO_NOT_TREAT 
    4847   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_chl   ! structure of input Chl (file informations, fields read) 
    4948   INTEGER ::   nksr   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
    5049   REAL(wp), DIMENSION(3,61) ::   rkrgb   !: tabulated attenuation coefficients for RGB absorption 
    51 !$AGRIF_END_DO_NOT_TREAT 
    5250 
    5351   !! * Substitutions 
    … …  
    144142!CDIR NOVERRCHK 
    145143                  DO ji = 1, jpi 
    146                      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) ) ) 
    147145                     irgb = NINT( 41 + 20.*LOG10(zchl) + 1.e-15 ) 
    148146                     zekb(ji,jj) = rkrgb(1,irgb) 
    … …  
    336334                  CALL ctl_stop( 'tra_qsr_init: unable to allocate sf_chl structure' )   ;   RETURN 
    337335               ENDIF 
    338                ALLOCATE( sf_chl(1)%fnow(jpi,jpj)   ) 
    339                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) ) 
    340338               !                                        ! fill sf_chl with sn_chl and control print 
    341339               CALL fld_fill( sf_chl, (/ sn_chl /), cn_dir, 'tra_qsr_init',   & 

  • branches/devmercator2010/NEMO/OPA_SRC/TRA/trasbc.F90

    r1892 r2071  
    134134               zta = ro0cpr * qns(ji,jj) * zse3t &                   ! temperature : heat flux 
    135135                &    - emp(ji,jj) * zsrau * tn(ji,jj,1)  * zse3t     ! & cooling/heating effet of EMP flux 
    136                zsa = ( emps(ji,jj) - emp(ji,jj) ) & 
    137                 &                 * zsrau * sn(ji,jj,1)  * zse3t     ! concent./dilut. effect due to sea-ice  
    138                                                                      ! melt/formation and (possibly) SSS restoration 
     136               zsa = 0.e0                                            ! No salinity concent./dilut. effect 
    139137            ELSE 
    140138               zta = ro0cpr * qns(ji,jj) * zse3t     ! temperature : heat flux 

  • branches/devmercator2010/NEMO/OPA_SRC/lib_mpp.F90

    r1921 r2071  
    103103   !! ========================= !! 
    104104!$AGRIF_DO_NOT_TREAT 
    105    INCLUDE 'mpif.h' 
     105#  include <mpif.h> 
    106106!$AGRIF_END_DO_NOT_TREAT 
    107107    
    … …  
    112112   INTEGER ::   mppsize        ! number of process 
    113113   INTEGER ::   mpprank        ! process number  [ 0 - size-1 ] 
    114 !$AGRIF_DO_NOT_TREAT 
    115    INTEGER, PUBLIC ::   mpi_comm_opa   ! opa local communicator 
    116 !$AGRIF_END_DO_NOT_TREAT 
     114   INTEGER ::   mpi_comm_opa   ! opa local communicator 
    117115 
    118116   ! variables used in case of sea-ice 
    … …  
    193191      WRITE(ldtxt(6),*) '      size in bytes of exported buffer   nn_buffer   = ', nn_buffer 
    194192 
    195       CALL mpi_initialized ( mpi_was_called, code ) 
    196       IF( code /= MPI_SUCCESS ) THEN 
    197          WRITE(*, cform_err) 
    198          WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 
    199          CALL mpi_abort( mpi_comm_world, code, ierr ) 
    200       ENDIF 
    201  
    202       IF( mpi_was_called ) THEN 
    203          ! 
     193#if defined key_agrif 
     194      IF( Agrif_Root() ) THEN 
     195#endif 
     196         !!bug RB : should be clean to use Agrif in coupled mode 
     197#if ! defined key_agrif 
     198         CALL mpi_initialized ( mpi_was_called, code ) 
     199         IF( code /= MPI_SUCCESS ) THEN 
     200            WRITE(*, cform_err) 
     201            WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 
     202            CALL mpi_abort( mpi_comm_world, code, ierr ) 
     203         ENDIF 
     204 
     205         IF( PRESENT(localComm) .and. mpi_was_called ) THEN 
     206            mpi_comm_opa = localComm 
     207            SELECT CASE ( cn_mpi_send ) 
     208            CASE ( 'S' )                ! Standard mpi send (blocking) 
     209               WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
     210            CASE ( 'B' )                ! Buffer mpi send (blocking) 
     211               WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
     212               CALL mpi_init_opa( ierr )  
     213            CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
     214               WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
     215               l_isend = .TRUE. 
     216            CASE DEFAULT 
     217               WRITE(ldtxt(7),cform_err) 
     218               WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
     219               nstop = nstop + 1 
     220            END SELECT 
     221         ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 
     222            WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 
     223            WRITE(ldtxt(8),*) '          without calling MPI_Init before ! ' 
     224            nstop = nstop + 1 
     225         ELSE 
     226#endif 
     227            SELECT CASE ( cn_mpi_send ) 
     228            CASE ( 'S' )                ! Standard mpi send (blocking) 
     229               WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
     230               CALL mpi_init( ierr ) 
     231            CASE ( 'B' )                ! Buffer mpi send (blocking) 
     232               WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
     233               CALL mpi_init_opa( ierr ) 
     234            CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
     235               WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
     236               l_isend = .TRUE. 
     237               CALL mpi_init( ierr ) 
     238            CASE DEFAULT 
     239               WRITE(ldtxt(7),cform_err) 
     240               WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
     241               nstop = nstop + 1 
     242            END SELECT 
     243 
     244#if ! defined key_agrif 
     245            CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 
     246            IF( code /= MPI_SUCCESS ) THEN 
     247               WRITE(*, cform_err) 
     248               WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 
     249               CALL mpi_abort( mpi_comm_world, code, ierr ) 
     250            ENDIF 
     251            ! 
     252         ENDIF 
     253#endif 
     254#if defined key_agrif 
     255      ELSE 
    204256         SELECT CASE ( cn_mpi_send ) 
    205257         CASE ( 'S' )                ! Standard mpi send (blocking) 
    … …  
    207259         CASE ( 'B' )                ! Buffer mpi send (blocking) 
    208260            WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
    209             CALL mpi_init_opa( ierr )  
    210261         CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    211262            WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
    … …  
    216267            nstop = nstop + 1 
    217268         END SELECT 
    218       ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 
    219          WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 
    220          WRITE(ldtxt(8),*) '          without calling MPI_Init before ! ' 
    221          nstop = nstop + 1 
    222       ELSE 
    223          SELECT CASE ( cn_mpi_send ) 
    224          CASE ( 'S' )                ! Standard mpi send (blocking) 
    225             WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
    226             CALL mpi_init( ierr ) 
    227          CASE ( 'B' )                ! Buffer mpi send (blocking) 
    228             WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
    229             CALL mpi_init_opa( ierr ) 
    230          CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    231             WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
    232             l_isend = .TRUE. 
    233             CALL mpi_init( ierr ) 
    234          CASE DEFAULT 
    235             WRITE(ldtxt(7),cform_err) 
    236             WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
    237             nstop = nstop + 1 
    238          END SELECT 
    239          ! 
    240269      ENDIF 
    241270 
    242       IF( PRESENT(localComm) ) THEN  
    243          IF( Agrif_Root() ) THEN 
    244             mpi_comm_opa = localComm 
    245          ENDIF 
    246       ELSE 
    247          CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 
    248          IF( code /= MPI_SUCCESS ) THEN 
    249             WRITE(*, cform_err) 
    250             WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 
    251             CALL mpi_abort( mpi_comm_world, code, ierr ) 
    252          ENDIF 
    253       ENDIF  
    254  
     271      mpi_comm_opa = mpi_comm_world 
     272#endif 
    255273      CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr ) 
    256274      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr ) 
    … …  
    20492067      ijpj   = 4 
    20502068      ijpjm1 = 3 
    2051       ztab(:,:,:) = 0.e0 
    20522069      ! 
    20532070      DO jj = nlcj - ijpj +1, nlcj          ! put in znorthloc the last 4 jlines of pt3d 
    … …  
    21152132      ijpj   = 4 
    21162133      ijpjm1 = 3 
    2117       ztab(:,:) = 0.e0 
    21182134      ! 
    21192135      DO jj = nlcj-ijpj+1, nlcj             ! put in znorthloc the last 4 jlines of pt2d 
    … …  
    21812197      ! 
    21822198      ijpj=4 
    2183       ztab(:,:) = 0.e0 
    21842199 
    21852200      ij=0 

  • branches/devmercator2010/NEMO/OPA_SRC/opa.F90

    r1793 r2071  
    156156      CALL opa_closefile 
    157157#if defined key_oasis3 || defined key_oasis4 
    158       IF( Agrif_Root() ) THEN 
    159          CALL cpl_prism_finalize           ! end coupling and mpp communications with OASIS 
    160      ENDIF  
     158      CALL cpl_prism_finalize           ! end coupling and mpp communications with OASIS 
    161159#else 
    162160      IF( lk_mpp )   CALL mppstop       ! end mpp communications 
    … …  
    193191#if defined key_iomput 
    194192# if defined key_oasis3 || defined key_oasis4 
    195       IF( Agrif_Root() ) THEN 
    196          CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
    197          CALL init_ioclient()                    ! io_server will get its communicators (if needed) from oasis (we don't see it) 
    198       ENDIF 
     193      CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
     194      CALL init_ioclient()                    ! io_server will get its communicators (if needed) from oasis (we don't see it) 
    199195# else 
    200       IF( Agrif_Root() ) THEN 
    201          CALL init_ioclient( ilocal_comm )       ! nemo local communicator (used or not) given by the io_server 
    202       ENDIF 
     196      CALL init_ioclient( ilocal_comm )       ! nemo local communicator (used or not) given by the io_server 
    203197# endif 
    204198      narea = mynode( cltxt, ilocal_comm )    ! Nodes selection 
    … …  
    206200#else 
    207201# if defined key_oasis3 || defined key_oasis4 
    208       IF( Agrif_Root() ) THEN 
    209          CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
    210       ENDIF 
     202      CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis 
    211203      narea = mynode( cltxt, ilocal_comm )    ! Nodes selection (control print return in cltxt) 
    212204# else 

  • branches/devmercator2010/NEMO/OPA_SRC/par_POMME_R025.h90

    r1876 r2071  
    2222      jp_cfg = 025  ,        &  !: resolution of the configuration (degrees) 
    2323      ! Original data size 
     24 
    2425      ! ORCA025 global grid size 
    2526      jpiglo_ORCA025 = 1442, & 
    2627      jpjglo_ORCA025 = 1021, &  ! not used currently 
     28 
    2729      ! POMME "global" domain localisation in the ORCA025 global grid 
    2830      jpi_iw    = 1059,      &  
    … …  
    3032      jpj_js    = 661,       & 
    3133      jpj_jn    = 700,       & 
     34 
    3235      jpidta  = ( jpi_ie - jpi_iw + 1 ), &   !: =30 first horizontal dimension > or = to jpi 
    3336      jpjdta  = ( jpj_jn - jpj_js + 1 ), &   !: =40 second                     > or = to jpj 
    3437      jpkdta  = 46 ,         &  !: number of levels           > or = to jpk 
     38 
    3539      ! total domain matrix size 
    3640      jpiglo  = jpidta,      &  !: first  dimension of global domain --> i 

  • branches/devmercator2010/NEMO/OPA_SRC/step.F90

    r1793 r2071  
    166166#if defined key_agrif 
    167167      kstp = nit000 + Agrif_Nb_Step() 
    168 !      IF( Agrif_Root() .and. lwp) Write(*,*) '---' 
    169 !      IF(lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 
    170 # if defined key_iomput 
    171       IF( Agrif_Nbstepint() == 0) CALL iom_swap 
    172 # endif    
     168!      IF ( Agrif_Root() .and. lwp) Write(*,*) '---' 
     169!      IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp 
    173170#endif    
    174171      indic = 1                                       ! reset to no error condition 

  • branches/devmercator2010/NEMO/OPA_SRC/trc_oce.F90

    r1834 r2071  
    126126      zrgb(1,51) =  3.162   ;   zrgb(2,51) = 0.22703   ;   zrgb(3,51) = 0.16599   ;   zrgb(4,51) = 0.46601 
    127127      zrgb(1,52) =  3.548   ;   zrgb(2,52) = 0.24433   ;   zrgb(3,52) = 0.17334   ;   zrgb(4,52) = 0.47313 
    128       zrgb(1,53) =  3.981   ;   zrgb(2,53) = 0.26301   ;   zrgb(3,53) = 0.18126   ;   zrgb(4,53) = 0.48080 
    129       zrgb(1,54) =  4.467   ;   zrgb(2,54) = 0.28320   ;   zrgb(3,54) = 0.18981   ;   zrgb(4,54) = 0.48909 
    130       zrgb(1,55) =  5.012   ;   zrgb(2,55) = 0.30502   ;   zrgb(3,55) = 0.19903   ;   zrgb(4,55) = 0.49803 
    131       zrgb(1,56) =  5.623   ;   zrgb(2,56) = 0.32858   ;   zrgb(3,56) = 0.20898   ;   zrgb(4,56) = 0.50768 
    132       zrgb(1,57) =  6.310   ;   zrgb(2,57) = 0.35404   ;   zrgb(3,57) = 0.21971   ;   zrgb(4,57) = 0.51810 
    133       zrgb(1,58) =  7.079   ;   zrgb(2,58) = 0.38154   ;   zrgb(3,58) = 0.23129   ;   zrgb(4,58) = 0.52934 
    134       zrgb(1,59) =  7.943   ;   zrgb(2,59) = 0.41125   ;   zrgb(3,59) = 0.24378   ;   zrgb(4,59) = 0.54147 
     128      zrgb(1,53) =  3.981   ;   zrgb(2,53) = 0.26301   ;   zrgb(3,53) = 0.18126   ;   zrgb(4,54) = 0.48080 
     129      zrgb(1,54) =  4.467   ;   zrgb(2,54) = 0.28320   ;   zrgb(3,54) = 0.18981   ;   zrgb(4,55) = 0.48909 
     130      zrgb(1,55) =  5.012   ;   zrgb(2,55) = 0.30502   ;   zrgb(3,55) = 0.19903   ;   zrgb(4,56) = 0.49803 
     131      zrgb(1,56) =  5.623   ;   zrgb(2,56) = 0.32858   ;   zrgb(3,56) = 0.20898   ;   zrgb(4,57) = 0.50768 
     132      zrgb(1,57) =  6.310   ;   zrgb(2,57) = 0.35404   ;   zrgb(3,57) = 0.21971   ;   zrgb(4,58) = 0.51810 
     133      zrgb(1,58) =  7.079   ;   zrgb(2,58) = 0.38154   ;   zrgb(3,58) = 0.23129   ;   zrgb(4,59) = 0.52934 
     134      zrgb(1,59) =  7.943   ;   zrgb(2,59) = 0.41125   ;   zrgb(3,59) = 0.24378   ;   zrgb(4,50) = 0.54147 
    135135      zrgb(1,60) =  8.912   ;   zrgb(2,60) = 0.44336   ;   zrgb(3,60) = 0.25725   ;   zrgb(4,60) = 0.55457 
    136136      zrgb(1,61) = 10.000   ;   zrgb(2,61) = 0.47804   ;   zrgb(3,61) = 0.27178   ;   zrgb(4,61) = 0.56870 
Note: See TracChangeset for help on using the changeset viewer.