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

Changeset 495


Ignore:
Timestamp:
2006-09-01T16:11:03+02:00 (18 years ago)
Author:
opalod
Message:

nemo_v1_update_063:CE+RB: use of IOM for offline passive tracers

Location:
trunk/NEMO/OFF_SRC
Files:
1 added
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/OFF_SRC/DOM/domrea.F90

    r439 r495  
    7777      !!        !  99-11  (M. Imbard)  NetCDF FORMAT with IOIPSL 
    7878      !!   9.0  !  02-08  (G. Madec)  F90 and several file 
     79      !!        !  06-07  (C. Ethe )  Use of iom module 
    7980      !!---------------------------------------------------------------------- 
    8081      !! * Modules used 
    81       USE ioipsl 
     82      USE iom 
    8283 
    8384      !! * Local declarations 
    84       LOGICAL ::   llog 
    85       INTEGER  ::   ji, jj, jk, ik 
     85      INTEGER  ::   ji, jj, jk 
    8686      INTEGER  ::                & !!! * temprary units for : 
    8787         inum0 ,                 &  ! 'mesh_mask.nc' file 
    … …  
    9090         inum3 ,                 &  ! 'mesh_hgr.nc'  file 
    9191         inum4                      ! 'mesh_zgr.nc'  file 
    92       INTEGER  ::   itime           !  output from restini ??? 
    93       REAL(wp) ::   zdate0, zdt 
    94       REAL(wp), DIMENSION(jpidta,jpjdta) ::   & 
    95          zta, zlamt, zphit       ! dummy array for bathymetry  
    96       REAL(wp) , DIMENSION(jpidta,jpjdta,jpk) :: & 
    97          zt3a      ! dummy array for bathymetry  
     92  
    9893      REAL(wp), DIMENSION(jpi,jpj) :: & 
    9994         zprt = 0. 
    10095 
    101       CHARACTER (len=21) ::      & 
    102          clnam0 = 'mesh_mask',   &  ! filename (mesh and mask informations) 
    103          clnam1 = 'mesh'     ,   &  ! filename (mesh informations) 
    104          clnam2 = 'mask'     ,   &  ! filename (mask informations) 
    105          clnam3 = 'mesh_hgr' ,   &  ! filename (horizontal mesh informations) 
    106          clnam4 = 'mesh_zgr'        ! filename (vertical   mesh informations) 
     96      REAL(wp), DIMENSION(1,1,jpk) :: & 
     97         zt1d 
    10798      !!---------------------------------------------------------------------- 
    10899 
    … …  
    111102       IF(lwp) WRITE(numout,*) '~~~~~~~' 
    112103 
    113       llog  = .FALSE. 
    114       zlamt(:,:) = 0.e0 
    115       zphit(:,:) = 0.e0 
    116  
    117       CALL ymds2ju( 0, 1, 1, 0.e0, zdate0 )    ! calendar initialization 
    118  
    119 !       note that mbathy has been modified in dommsk or in solver. 
    120 !       it is the number of non-zero "w" levels in the water, and the minimum  
    121 !       value (on land) is 2. We define zprt as the number of "T" points in the ocean  
    122 !       at any location, and zero on land.  
    123 ! 
     104 
    124105 
    125106      SELECT CASE (nmsh) 
    … …  
    129110 
    130111            IF(lwp) WRITE(numout,*) '          one file in "mesh_mask.nc" ' 
    131             CALL restini( clnam0, jpidta   , jpjdta   , zlamt, zphit,  &   ! create 'mesh_mask.nc' file 
    132             &             jpk   , gdept , trim(clnam0)        ,  &   ! in unit inum0 
    133             &             itime , zdate0, zdt   , inum0, domain_id=nidom ) 
     112            CALL iom_open( 'mesh_mask', inum0 ) 
     113 
    134114            inum2 = inum0                                            ! put all the informations 
    135115            inum3 = inum0                                            ! in unit inum0 
    … …  
    142122 
    143123            IF(lwp) WRITE(numout,*) '          two files in "mesh.nc" and "mask.nc" ' 
    144             CALL restini( clnam1, jpidta   , jpjdta   , zlamt, zphit,  &   ! create 'mesh.nc' file  
    145             &             jpk   , gdept , trim(clnam1)        ,  &   ! in unit inum1  
    146             &             itime , zdate0, zdt   , inum1, domain_id=nidom ) 
    147             CALL restini( clnam2, jpidta   , jpjdta   , zlamt, zphit,  &   ! create 'mask.nc' file  
    148             &             jpk   , gdept , trim(clnam2)        ,  &   ! in unit inum2  
    149             &             itime , zdate0, zdt   , inum2, domain_id=nidom ) 
     124            CALL iom_open( 'mesh', inum1 ) 
     125            CALL iom_open( 'mask', inum2 ) 
     126 
    150127            inum3 = inum1                                            ! put mesh informations  
    151128            inum4 = inum1                                            ! in unit inum1  
    … …  
    158135 
    159136            IF(lwp) WRITE(numout,*) '          three files in "mesh_hgr.nc" , mesh_zgr.nc" and "mask.nc" ' 
    160             CALL restini( clnam3, jpidta   , jpjdta   , zlamt, zphit,  &   ! create 'mesh_hgr.nc' file 
    161             &             jpk   , gdept , trim(clnam3)        ,  &   ! in unit inum3 
    162             &             itime , zdate0, zdt   , inum3, domain_id=nidom ) 
    163             CALL restini( clnam4, jpidta   , jpjdta   , zlamt, zphit,  &   ! create 'mesh_zgr.nc' file 
    164             &             jpk   , gdept , trim(clnam4)        ,  &   ! in unit inum4 
    165             &             itime , zdate0, zdt   , inum4, domain_id=nidom ) 
    166             CALL restini( clnam2, jpidta   , jpjdta   , zlamt, zphit,  &   ! create 'mask.nc' file 
    167             &             jpk   , gdept , trim(clnam2)        ,  &   ! in unit inum2 
    168             &             itime , zdate0, zdt   , inum2, domain_id=nidom ) 
     137            CALL iom_open( 'mesh_hgr', inum3 ) ! create 'mesh_hgr.nc' 
     138            CALL iom_open( 'mesh_zgr', inum4 ) ! create 'mesh_zgr.nc' 
     139            CALL iom_open( 'mask'    , inum2 ) ! create 'mask.nc' 
    169140 
    170141         END SELECT 
    171142 
    172143         !                                                         ! masks (inum2)  
    173          CALL restget( inum2, 'tmask', jpidta, jpjdta, jpk, 0, llog, zt3a )  
    174          DO jk = 1, jpk 
    175            DO jj = 1, nlcj 
    176              DO ji = 1, nlci 
    177                tmask(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk) 
    178              END DO 
    179            END DO 
    180          END DO 
    181          CALL restget( inum2, 'umask', jpidta, jpjdta, jpk, 0, llog, zt3a ) 
    182          DO jk = 1, jpk 
    183            DO jj = 1, nlcj 
    184              DO ji = 1, nlci 
    185                umask(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk) 
    186              END DO 
    187            END DO 
    188          END DO 
    189          CALL restget( inum2, 'vmask', jpidta, jpjdta, jpk, 0, llog, zt3a ) 
    190          DO jk = 1, jpk 
    191            DO jj = 1, nlcj 
    192              DO ji = 1, nlci 
    193                vmask(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk) 
    194              END DO 
    195            END DO 
    196          END DO 
    197          CALL restget( inum2, 'fmask', jpidta, jpjdta, jpk, 0, llog, zt3a ) 
    198          DO jk = 1, jpk 
    199            DO jj = 1, nlcj 
    200              DO ji = 1, nlci 
    201                fmask(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk) 
    202              END DO 
    203            END DO 
    204          END DO 
     144         CALL iom_get( inum2, jpdom_data, 'tmask', tmask ) 
     145         CALL iom_get( inum2, jpdom_data, 'umask', umask ) 
     146         CALL iom_get( inum2, jpdom_data, 'vmask', vmask ) 
     147         CALL iom_get( inum2, jpdom_data, 'fmask', fmask ) 
    205148 
    206149#if defined key_cfg_1d 
    207       IF(lwp) WRITE(numout,*) '**********  1D configuration : set umask and vmask equal tmask ********' 
    208       IF(lwp) WRITE(numout,*) '**********                                                     ********' 
    209       ! set umask and vmask equal tmask in 1D configuration 
    210       umask(:,:,:) = tmask(:,:,:) 
    211       vmask(:,:,:) = tmask(:,:,:) 
     150         ! set umask and vmask equal tmask in 1D configuration 
     151         IF(lwp) WRITE(numout,*) 
     152         IF(lwp) WRITE(numout,*) '**********  1D configuration : set umask and vmask equal tmask ********' 
     153         IF(lwp) WRITE(numout,*) '**********                                                     ********' 
     154 
     155         umask(:,:,:) = tmask(:,:,:) 
     156         vmask(:,:,:) = tmask(:,:,:) 
    212157#endif 
    213158 
    214159#if defined key_off_degrad 
    215          CALL restget( inum2, 'facvolt', jpidta, jpjdta, jpk, 0, llog, zt3a ) 
    216          DO jk = 1, jpk 
    217            DO jj = 1, nlcj 
    218              DO ji = 1, nlci 
    219                facvol(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk) 
    220              END DO 
    221            END DO 
    222          END DO 
     160         CALL iom_get( inum2, jpdom_data, 'facvolt', facvol ) 
    223161#endif 
    224162 
    225163         !                                                         ! horizontal mesh (inum3) 
    226          CALL restget( inum3, 'glamt', jpidta, jpjdta, 1, 0, llog, zta )     !    ! latitude 
    227            DO jj = 1, nlcj 
    228              DO ji = 1, nlci 
    229                glamt(ji,jj) = zta(mig(ji),mjg(jj)) 
    230              END DO 
    231            END DO 
    232          CALL restget( inum3, 'glamu', jpidta, jpjdta, 1, 0, llog, zta ) 
    233            DO jj = 1, nlcj 
    234              DO ji = 1, nlci 
    235                glamu(ji,jj) = zta(mig(ji),mjg(jj)) 
    236              END DO 
    237            END DO 
    238          CALL restget( inum3, 'glamv', jpidta, jpjdta, 1, 0, llog, zta ) 
    239            DO jj = 1, nlcj 
    240              DO ji = 1, nlci 
    241                glamv(ji,jj) = zta(mig(ji),mjg(jj)) 
    242              END DO 
    243            END DO 
    244          CALL restget( inum3, 'glamf', jpidta, jpjdta, 1, 0, llog, zta ) 
    245            DO jj = 1, nlcj 
    246              DO ji = 1, nlci 
    247                glamf(ji,jj) = zta(mig(ji),mjg(jj)) 
    248              END DO 
    249            END DO 
    250  
    251          CALL restget( inum3, 'gphit', jpidta, jpjdta, 1, 0, llog, zta )     !    ! longitude 
    252            DO jj = 1, nlcj 
    253              DO ji = 1, nlci 
    254                gphit(ji,jj) = zta(mig(ji),mjg(jj)) 
    255              END DO 
    256            END DO 
    257          CALL restget( inum3, 'gphiu', jpidta, jpjdta, 1, 0, llog, zta ) 
    258            DO jj = 1, nlcj 
    259              DO ji = 1, nlci 
    260                gphiu(ji,jj) = zta(mig(ji),mjg(jj)) 
    261              END DO 
    262            END DO 
    263          CALL restget( inum3, 'gphiv', jpidta, jpjdta, 1, 0, llog, zta ) 
    264            DO jj = 1, nlcj 
    265              DO ji = 1, nlci 
    266                gphiv(ji,jj) = zta(mig(ji),mjg(jj)) 
    267              END DO 
    268            END DO 
    269          CALL restget( inum3, 'gphif', jpidta, jpjdta, 1, 0, llog, zta ) 
    270            DO jj = 1, nlcj 
    271              DO ji = 1, nlci 
    272                gphif(ji,jj) = zta(mig(ji),mjg(jj)) 
    273              END DO 
    274            END DO 
    275  
    276          CALL restget( inum3, 'e1t', jpidta, jpjdta, 1, 0, llog, zta )         !    ! e1 scale factors 
    277            DO jj = 1, nlcj 
    278              DO ji = 1, nlci 
    279                e1t(ji,jj) = zta(mig(ji),mjg(jj)) 
    280              END DO 
    281            END DO 
    282          CALL restget( inum3, 'e1u', jpidta, jpjdta, 1, 0, llog, zta ) 
    283            DO jj = 1, nlcj 
    284              DO ji = 1, nlci 
    285                e1u(ji,jj) = zta(mig(ji),mjg(jj)) 
    286              END DO 
    287            END DO 
    288          CALL restget( inum3, 'e1v', jpidta, jpjdta, 1, 0, llog, zta ) 
    289            DO jj = 1, nlcj 
    290              DO ji = 1, nlci 
    291                e1v(ji,jj) = zta(mig(ji),mjg(jj)) 
    292              END DO 
    293            END DO 
    294          CALL restget( inum3, 'e2t', jpidta, jpjdta, 1, 0, llog, zta )         !    ! e2 scale factors 
    295            DO jj = 1, nlcj 
    296              DO ji = 1, nlci 
    297                e2t(ji,jj) = zta(mig(ji),mjg(jj)) 
    298              END DO 
    299            END DO 
    300          CALL restget( inum3, 'e2u', jpidta, jpjdta, 1, 0, llog, zta ) 
    301            DO jj = 1, nlcj 
    302              DO ji = 1, nlci 
    303                e2u(ji,jj) = zta(mig(ji),mjg(jj)) 
    304              END DO 
    305            END DO 
    306          CALL restget( inum3, 'e2v', jpidta, jpjdta, 1, 0, llog, zta ) 
    307            DO jj = 1, nlcj 
    308              DO ji = 1, nlci 
    309                e2v(ji,jj) = zta(mig(ji),mjg(jj)) 
    310              END DO 
    311            END DO 
    312          CALL restget( inum3, 'ff', jpidta, jpjdta, 1, 0, llog, zta )           !    ! coriolis factor 
    313            DO jj = 1, nlcj 
    314              DO ji = 1, nlci 
    315                ff(ji,jj) = zta(mig(ji),mjg(jj)) 
    316              END DO 
    317            END DO 
    318  
    319          CALL restget( inum4, 'mbathy', jpidta, jpjdta, 1, 0, llog, zta ) 
    320 ! Bathymetry 
    321            DO jj = 1, nlcj 
    322              DO ji = 1, nlci 
    323                zprt(ji,jj) = zta(mig(ji),mjg(jj)) 
    324              END DO 
    325            END DO 
    326  
    327          mbathy(:,:)=zprt(:,:)*tmask(:,:,1)+1 
    328  
    329 # if defined key_s_coord 
    330          !                                                         ! s-coordinate 
    331          CALL restget( inum4, 'hbatt', jpidta, jpjdta, 1, 0, llog, zta )      !    ! depth 
    332            DO jj = 1, nlcj 
    333              DO ji = 1, nlci 
    334                hbatt(ji,jj) = zta(mig(ji),mjg(jj)) 
    335              END DO 
    336            END DO 
    337          CALL restget( inum4, 'hbatu', jpidta, jpjdta, 1, 0, llog, zta )  
    338            DO jj = 1, nlcj 
    339              DO ji = 1, nlci 
    340                hbatu(ji,jj) = zta(mig(ji),mjg(jj)) 
    341              END DO 
    342            END DO 
    343          CALL restget( inum4, 'hbatv', jpidta, jpjdta, 1, 0, llog, zta ) 
    344            DO jj = 1, nlcj 
    345              DO ji = 1, nlci 
    346                hbatv(ji,jj) = zta(mig(ji),mjg(jj)) 
    347              END DO 
    348            END DO 
    349          CALL restget( inum4, 'hbatf', jpidta, jpjdta, 1, 0, llog, zta ) 
    350            DO jj = 1, nlcj 
    351              DO ji = 1, nlci 
    352                hbatf(ji,jj) = zta(mig(ji),mjg(jj)) 
    353              END DO 
    354            END DO 
    355  
    356          CALL restget( inum4, 'gsigt', 1, 1, jpk, 0, llog, gsigt )        !    ! scaling coef. 
    357          CALL restget( inum4, 'gsigw', 1, 1, jpk, 0, llog, gsigw )   
    358          CALL restget( inum4, 'gsi3w', 1, 1, jpk, 0, llog, gsi3w ) 
    359          CALL restget( inum4, 'esigt', 1, 1, jpk, 0, llog, esigt ) 
    360          CALL restget( inum4, 'esigw', 1, 1, jpk, 0, llog, esigw ) 
    361  
    362 # elif defined key_partial_steps 
    363          !                                                          ! z-coordinate with partial steps 
    364          CALL restget( inum4, 'hdept' , jpidta, jpjdta, 1, 0, llog, zta  )    !    ! depth 
    365            DO jj = 1, nlcj 
    366              DO ji = 1, nlci 
    367                hdept(ji,jj) = zta(mig(ji),mjg(jj)) 
    368              END DO 
    369            END DO 
    370          CALL restget( inum4, 'hdepw' , jpidta, jpjdta, 1, 0, llog, zta  )  
    371            DO jj = 1, nlcj 
    372              DO ji = 1, nlci 
    373                hdepw(ji,jj) = zta(mig(ji),mjg(jj)) 
    374              END DO 
    375            END DO 
    376  
    377          CALL restget( inum4, 'e3t_ps', jpidta, jpjdta, jpk, 0, llog, zt3a )  !    ! scale factors 
    378          DO jk = 1, jpk 
    379            DO jj = 1, nlcj 
    380              DO ji = 1, nlci 
    381                e3t_ps(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk) 
    382              END DO 
    383            END DO 
    384          END DO 
    385          CALL restget( inum4, 'e3u_ps', jpidta, jpjdta, jpk, 0, llog, zt3a ) 
    386          DO jk = 1, jpk 
    387            DO jj = 1, nlcj 
    388              DO ji = 1, nlci 
    389                e3u_ps(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk) 
    390              END DO 
    391            END DO 
    392          END DO 
    393          CALL restget( inum4, 'e3v_ps', jpidta, jpjdta, jpk, 0, llog, zt3a ) 
    394          DO jk = 1, jpk 
    395            DO jj = 1, nlcj 
    396              DO ji = 1, nlci 
    397                e3v_ps(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk) 
    398              END DO 
    399            END DO 
    400          END DO 
    401          CALL restget( inum4, 'e3w_ps', jpidta, jpjdta, jpk, 0, llog, zt3a ) 
    402          DO jk = 1, jpk 
    403            DO jj = 1, nlcj 
    404              DO ji = 1, nlci 
    405                e3w_ps(ji,jj,jk) = zt3a(mig(ji),mjg(jj),jk) 
    406              END DO 
    407            END DO 
    408          END DO 
    409  
    410          CALL restget( inum4, 'gdept' , 1, 1, jpk, 0, llog, gdept )       !    ! reference z-coord. 
    411          CALL restget( inum4, 'gdepw' , 1, 1, jpk, 0, llog, gdepw ) 
    412          CALL restget( inum4, 'e3t'   , 1, 1, jpk, 0, llog, e3t   ) 
    413          CALL restget( inum4, 'e3w'   , 1, 1, jpk, 0, llog, e3w   ) 
    414  
    415          DO jk=1,jpk 
    416             gdept_ps(:,:,jk) = gdept(jk) 
    417             gdepw_ps(:,:,jk) = gdepw(jk) 
    418          END DO 
    419  
    420          DO jj = 1, jpj 
    421             DO ji = 1, jpi 
    422                ik = mbathy(ji,jj) - 1 
    423                ! ocean point only  
    424                IF( ik > 0 ) THEN 
    425                   ! max ocean level case 
    426                   gdepw_ps(ji,jj,ik+1) = hdepw(ji,jj) 
    427                   gdept_ps(ji,jj,ik  ) = hdept(ji,jj) 
    428                   gdept_ps(ji,jj,ik+1) = gdept_ps(ji,jj,ik) + e3t_ps(ji,jj,ik) 
    429                ENDIF 
     164         CALL iom_get( inum3, jpdom_data, 'glamt', glamt ) 
     165         CALL iom_get( inum3, jpdom_data, 'glamu', glamu ) 
     166         CALL iom_get( inum3, jpdom_data, 'glamv', glamv ) 
     167         CALL iom_get( inum3, jpdom_data, 'glamf', glamf ) 
     168 
     169         CALL iom_get( inum3, jpdom_data, 'gphit', gphit ) 
     170         CALL iom_get( inum3, jpdom_data, 'gphiu', gphiu ) 
     171         CALL iom_get( inum3, jpdom_data, 'gphiv', gphiv ) 
     172         CALL iom_get( inum3, jpdom_data, 'gphif', gphif ) 
     173 
     174         CALL iom_get( inum3, jpdom_data, 'e1t', e1t ) 
     175         CALL iom_get( inum3, jpdom_data, 'e1u', e1u ) 
     176         CALL iom_get( inum3, jpdom_data, 'e1v', e1v ) 
     177          
     178         CALL iom_get( inum3, jpdom_data, 'e2t', e2t ) 
     179         CALL iom_get( inum3, jpdom_data, 'e2u', e2u ) 
     180         CALL iom_get( inum3, jpdom_data, 'e2v', e2v ) 
     181 
     182         CALL iom_get( inum3, jpdom_data, 'ff', ff ) 
     183 
     184         CALL iom_get( inum4, jpdom_data, 'mbathy', zprt ) 
     185         mbathy(:,:) = zprt(:,:) * tmask(:,:,1) + 1 
     186 
     187#if ! defined key_zco 
     188         IF( ln_sco ) THEN                                         ! s-coordinate 
     189            CALL iom_get( inum4, jpdom_data, 'hbatt', hbatt ) 
     190            CALL iom_get( inum4, jpdom_data, 'hbatu', hbatu ) 
     191            CALL iom_get( inum4, jpdom_data, 'hbatv', hbatv ) 
     192            CALL iom_get( inum4, jpdom_data, 'hbatf', hbatf ) 
     193             
     194            CALL iom_get( inum4, jpdom_unknown, 'gsigt', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) ! scaling coef. 
     195            gsigt(:) = zt1d(1,1,:)  
     196            CALL iom_get( inum4, jpdom_unknown, 'gsigw', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) 
     197            gsigw(:) = zt1d(1,1,:)  
     198            CALL iom_get( inum4, jpdom_unknown, 'gsi3w', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) )  
     199            gsi3w(:) = zt1d(1,1,:)  
     200            CALL iom_get( inum4, jpdom_unknown, 'esigt', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) 
     201            esigt(:) = zt1d(1,1,:)  
     202            CALL iom_get( inum4, jpdom_unknown, 'esigw', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) 
     203            esigw(:) = zt1d(1,1,:)  
     204 
     205            CALL iom_get( inum4, jpdom_data, 'e3t', e3t ) ! scale factors 
     206            CALL iom_get( inum4, jpdom_data, 'e3u', e3u ) 
     207            CALL iom_get( inum4, jpdom_data, 'e3v', e3v ) 
     208            CALL iom_get( inum4, jpdom_data, 'e3w', e3w ) 
     209 
     210            CALL iom_get( inum4, jpdom_unknown, 'gdept_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) ! depth 
     211            gdept_0(:) = zt1d(1,1,:)  
     212            CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) 
     213            gdepw_0(:) = zt1d(1,1,:)  
     214         ENDIF 
     215 
     216         IF( ln_zps ) THEN                                         ! z-coordinate - partial steps 
     217            CALL iom_get( inum4, jpdom_data, 'hdept', hdept )   ! depth 
     218            CALL iom_get( inum4, jpdom_data, 'hdepw', hdepw ) 
     219 
     220            CALL iom_get( inum4, jpdom_data, 'e3t', e3t ) ! scale factors 
     221            CALL iom_get( inum4, jpdom_data, 'e3u', e3u ) 
     222            CALL iom_get( inum4, jpdom_data, 'e3v', e3v ) 
     223            CALL iom_get( inum4, jpdom_data, 'e3w', e3w ) 
     224            !                                                          ! reference z-coord. 
     225            CALL iom_get( inum4, jpdom_unknown, 'gdept_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) )  
     226            gdept_0(:) = zt1d(1,1,:)  
     227            CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) 
     228            gdepw_0(:) = zt1d(1,1,:)  
     229            CALL iom_get( inum4, jpdom_unknown, 'e3t_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) 
     230            e3t_0(:) = zt1d(1,1,:)  
     231            CALL iom_get( inum4, jpdom_unknown, 'e3w_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) 
     232            e3w_0(:) = zt1d(1,1,:)  
     233  
     234            DO jk = 1,jpk 
     235               gdept(:,:,jk) = gdept(jk) 
     236               gdepw(:,:,jk) = gdepw(jk) 
    430237            END DO 
    431          END DO 
    432238          
     239            DO jj = 1, jpj 
     240               DO ji = 1, jpi 
     241                  ik = mbathy(ji,jj) - 1 
     242                  ! ocean point only  
     243                  IF( ik > 0 ) THEN 
     244                     ! max ocean level case 
     245                     gdepw(ji,jj,ik+1) = hdepw(ji,jj) 
     246                     gdept(ji,jj,ik  ) = hdept(ji,jj) 
     247                     gdept(ji,jj,ik+1) = gdept(ji,jj,ik) + e3t(ji,jj,ik) 
     248                  ENDIF 
     249               END DO 
     250            END DO 
     251         ENDIF 
     252             
    433253 
    434254# else 
    435          !                                                          ! z-coordinate  
    436          CALL restget( inum4, 'gdept', 1, 1, jpk, 0, llog, gdept )        !    ! depth 
    437          CALL restget( inum4, 'gdepw', 1, 1, jpk, 0, llog, gdepw ) 
    438          CALL restget( inum4, 'e3t'  , 1, 1, jpk, 0, llog, e3t   )        !    ! scale factors 
    439          CALL restget( inum4, 'e3w'  , 1, 1, jpk, 0, llog, e3w   ) 
     255         !                                                                     !  z-coord. 
     256         CALL iom_get( inum4, jpdom_unknown, 'gdept_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) ! depth   
     257         gdept_0(:) = zt1d(1,1,:)  
     258         CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) 
     259         gdepw_0(:) = zt1d(1,1,:)  
     260         CALL iom_get( inum4, jpdom_unknown, 'e3t_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) ! scale factors 
     261         e3t_0(:) = zt1d(1,1,:)  
     262         CALL iom_get( inum4, jpdom_unknown, 'e3w_0', zt1d, kstart=(/1,1,1/), kcount=(/1,1,jpk/) ) 
     263         e3w_0(:) = zt1d(1,1,:)  
     264 
    440265# endif 
    441266 
    … …  
    477302         WRITE(numout,*) '              Reference z-coordinate depth and scale factors:' 
    478303         WRITE(numout, "(9x,' level   gdept    gdepw     e3t      e3w  ')" ) 
    479          WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept(jk), gdepw(jk), e3t(jk), e3w(jk), jk = 1, jpk ) 
     304         WRITE(numout, "(10x, i4, 4f9.2)" ) ( jk, gdept_0(jk), gdepw_0(jk), e3t_0(jk), e3w_0(jk), jk = 1, jpk ) 
    480305      ENDIF 
    481306 
    482307      DO jk = 1, jpk 
    483          IF( e3w(jk) <= 0. .OR. e3t(jk) <= 0. ) THEN 
    484             IF(lwp) WRITE(numout,cform_err) 
    485             IF(lwp) WRITE(numout,*) ' e3w or e3t =< 0 ' 
    486             nstop = nstop + 1 
    487          ENDIF 
    488          IF( gdepw(jk) < 0. .OR. gdept(jk) < 0.) THEN 
    489             IF(lwp) WRITE(numout,cform_err) 
    490             IF(lwp) WRITE(numout,*) ' gdepw or gdept < 0 ' 
    491             nstop = nstop + 1 
    492          ENDIF 
     308         IF( e3w_0(jk) <= 0. .OR. e3t_0(jk) <= 0. ) CALL ctl_stop ( ' e3w_0 or e3t_0 =< 0 ' ) 
     309         IF( gdepw_0(jk) < 0. .OR. gdept_0(jk) < 0.) CALL ctl_stop( ' gdepw_0 or gdept_0 < 0 ' ) 
    493310      END DO 
    494311 
    … …  
    498315         SELECT CASE ( nmsh ) 
    499316            CASE ( 1 )                 
    500                CALL restclo( inum0 ) 
     317               CALL iom_close( inum0 ) 
    501318            CASE ( 2 ) 
    502                CALL restclo( inum1 ) 
    503                CALL restclo( inum2 ) 
     319               CALL iom_close( inum1 ) 
     320               CALL iom_close( inum2 ) 
    504321            CASE ( 3 ) 
    505                CALL restclo( inum2 ) 
    506                CALL restclo( inum3 ) 
    507                CALL restclo( inum4 ) 
     322               CALL iom_close( inum2 ) 
     323               CALL iom_close( inum3 ) 
     324               CALL iom_close( inum4 ) 
    508325         END SELECT 
    509326 

  • trunk/NEMO/OFF_SRC/SBC/flxrnf.F90

    r343 r495  
    2222   USE in_out_manager  ! I/O manager 
    2323   USE daymod          ! calendar 
    24    USE ioipsl          ! NetCDF IPSL library 
     24   USE iom             ! I/O module 
    2525 
    2626   IMPLICIT NONE 
    … …  
    3838      upsrnfz              !: mixed adv scheme in runoffs vicinity (vert.) 
    3939   INTEGER, PUBLIC ::   &  !: 
    40       nrunoff =  0 ,    &  !: runoff option (namelist) 
    41       nrnf1, nrnf2         !: first and second record used 
     40      nrunoff =  0         !: runoff option (namelist) 
    4241 
    4342   !! * Module variable 
    4443   REAL(wp), DIMENSION(jpi,jpj,2) ::   &  !: 
    4544      rnfdta               !: monthly runoff data array (kg/m2/s) 
    46  
    47    !!---------------------------------------------------------------------- 
    48    !!   OPA 9.0 , LOCEAN-IPSL  (2005) 
    49    !!   $Header$ 
    50    !!   This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     45   INTEGER  ::          &  !: 
     46      numrnf,           &  !: logical unit for runoff data 
     47      nrnf1, nrnf2         !: first and second record used 
     48   !!---------------------------------------------------------------------- 
     49   !!   OPA 9.0 , LOCEAN-IPSL (2005)  
     50   !! $Header$  
     51   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt  
    5152   !!---------------------------------------------------------------------- 
    5253 
    … …  
    104105      REAL(wp) ::   zxy 
    105106# endif 
    106       CHARACTER (len=32) ::   & 
    107          clname = 'runoff_1m_nomask'       ! monthly runoff filename 
    108       INTEGER, PARAMETER :: jpmois = 12 
    109       INTEGER  ::   ipi, ipj, ipk          ! temporary integers 
    110107      INTEGER  ::   ii0, ii1, ij0, ij1     !    "          " 
    111       INTEGER, DIMENSION(jpmois) ::     & 
    112          istep                             ! temporary workspace 
    113       REAL(wp) ::   zdate0, zdt            ! temporary scalars 
    114       REAL(wp), DIMENSION(jpk) ::       & 
    115          zlev                              ! temporary workspace 
    116       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    117          zlon, zlat,                    &  ! temporary workspace 
    118          zcoefr                            ! coeff of advection link to runoff 
    119108      !!---------------------------------------------------------------------- 
    120109       
    … …  
    139128 
    140129         CASE DEFAULT 
    141             IF(lwp) WRITE(numout,cform_err) 
    142             IF(lwp) WRITE(numout,*) ' Error nrunoff = ', nrunoff, ' /= 0, 1 or 2' 
    143             nstop = nstop + 1 
     130            WRITE(ctmp1,*) ' Error nrunoff = ', nrunoff, ' /= 0, 1 or 2' 
     131            CALL ctl_stop( ctmp1 ) 
    144132 
    145133         END SELECT 
    146134 
    147135         ! Set runoffs and upstream coeff to zero 
    148          runoff (:,:) = 0.e0 
    149          upsrnfh(:,:) = 0.e0 
    150          upsrnfz(:)   = 0.e0  
    151136         upsadv (:,:) = 0.e0 
    152137 
    … …  
    161146 
    162147         ! year, month, day 
    163  
    164          iman  = jpmois 
     148         iman  = INT( raamo ) 
     149!!! better but change the results      i15 = INT( 2*FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) 
    165150         i15   = nday / 16 
    166151         imois = nmonth + i15 - 1 
    167          IF( imois == 0 )   imois = iman 
     152         IF( imois == 0 ) imois = iman 
    168153         ! Number of days in the month 
    169154         IF( nleapy == 1 .AND. MOD( nyear, 4 ) == 0 ) THEN 
    … …  
    177162         idmeom = idbd - 15 
    178163# endif 
    179          ipi = jpiglo 
    180          ipj = jpjglo 
    181          ipk = jpk 
    182          zdt = rdt 
    183164          
    184165         ! Open file 
    185166 
    186167         IF( kt == nit000 ) THEN 
    187             CALL flinopen( clname, mig(1), nlci, mjg(1), nlcj,    & 
    188                &           .false., ipi, ipj, ipk, zlon,        & 
    189                &           zlat, zlev, jpmois, istep, zdate0,   & 
    190                &           zdt, numrnf ) 
    191             !   Title, dimensions and tests 
    192 # if ! defined key_coupled 
    193             IF( iman /= jpmois ) THEN 
    194                IF(lwp) WRITE(numout,*) 
    195                IF(lwp) WRITE(numout,*) 'problem with time coordinates' 
    196                IF(lwp) WRITE(numout,*) ' iman ', iman, ' jpmois ', jpmois 
    197                nstop = nstop + 1 
    198             ENDIF 
    199             IF(lwp) WRITE(numout,*) iman, istep, zdate0, rdt, numrnf 
    200             IF(lwp) WRITE(numout,*) 'numrnf=', numrnf 
    201             IF(lwp) WRITE(numout,*) 'jpmois=', jpmois 
    202             IF(lwp) WRITE(numout,*) 'zdt=', zdt 
    203 # endif 
    204             IF(ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1) THEN 
    205                IF(lwp)WRITE(numout,*) ' ' 
    206                IF(lwp)WRITE(numout,*) 'problem with dimensions' 
    207                IF(lwp)WRITE(numout,*) ' ipi ', ipi, ' jpidta ', jpidta 
    208                IF(lwp)WRITE(numout,*) ' ipj ', ipj, ' jpjdta ', jpjdta 
    209                IF(lwp)WRITE(numout,*) ' ipk ', ipk, ' =? 1' 
    210                nstop = nstop + 1 
    211             ENDIF 
    212             IF(lwp)WRITE(numout,*) 'ipi=', ipi, ' ipj=', ipj, ' ipk=', ipk 
     168 
     169            nrnf1 = 0   ! initialization 
     170            IF (lwp) WRITE(numout,*) 'flx_rnf : Monthly runoff' 
     171            CALL iom_open ( 'runoff_1m_nomask.nc', numrnf ) 
     172             
    213173         ENDIF 
    214174          
    … …  
    237197               WRITE(numout,*) ' NetCDF format' 
    238198               WRITE(numout,*) 
    239                WRITE(numout,*) 'first array record used nrnf1 ',nrnf1 
    240                WRITE(numout,*) 'last  array record used nrnf2 ',nrnf2 
     199               WRITE(numout,*) 'first array record used nrnf1 ', nrnf1 
     200               WRITE(numout,*) 'last  array record used nrnf2 ', nrnf2 
    241201               WRITE(numout,*) 
    242202            ENDIF 
    243203             
    244204            ! Read monthly runoff data in kg/m2/s 
    245 !ibug 
    246             IF( kt == nit000 )   rnfdta(:,:,:) = 0.e0 
    247 !ibug 
    248             CALL flinget( numrnf, 'sorunoff', jpidta, jpjdta, 1, jpmois   & 
    249                &        , nrnf1, nrnf1, mig(1), nlci, mjg(1), nlcj, rnfdta(1:nlci,1:nlcj,1) ) 
    250             CALL flinget( numrnf, 'sorunoff', jpidta, jpjdta, 1, jpmois   & 
    251                &        , nrnf2, nrnf2, mig(1), nlci, mjg(1), nlcj, rnfdta(1:nlci,1:nlcj,2) ) 
    252  
    253             IF(lwp) WRITE(numout,*) 
    254             IF(lwp) WRITE(numout,*) ' read runoff field ok' 
    255             IF(lwp) WRITE(numout,*) 
     205 
     206            CALL iom_get ( numrnf, jpdom_data, 'sorunoff', rnfdta(:,:,1), nrnf1 ) 
     207            CALL iom_get ( numrnf, jpdom_data, 'sorunoff', rnfdta(:,:,2), nrnf2 ) 
    256208 
    257209         ENDIF 
    … …  
    264216         runoff(:,:) = -( ( 1.e0 - zxy ) * rnfdta(:,:,1) + zxy * rnfdta(:,:,2) ) 
    265217 
    266          ! Runoff reduction 
    267          DO jj = 1, jpj 
    268             DO ji = 1, jpi 
    269                IF( gphit(ji,jj) > 40 .AND. gphit(ji,jj) < 65 )   runoff(ji,jj) = 0.85 * runoff(ji,jj) 
     218         ! Runoff reduction only associated to the ORCA2_LIM configuration 
     219         ! when reading the NetCDF file runoff_1m_nomask.nc 
     220         IF( cp_cfg == 'orca' .AND. jp_cfg == 2 )   THEN 
     221            DO jj = 1, jpj 
     222               DO ji = 1, jpi 
     223                  IF( gphit(ji,jj) > 40 .AND. gphit(ji,jj) < 65 )   runoff(ji,jj) = 0.85 * runoff(ji,jj) 
     224               END DO 
    270225            END DO 
    271          END DO 
     226         ENDIF 
    272227          
    273228# endif 
    … …  
    287242         !  coefr * upstream + (1- coefr) centered 
    288243         !  coefr must be between 0 and 1. 
    289 !ibug 
    290          zcoefr(:,:) = 0.e0 
    291 !ibug 
    292  
    293          CALL flinget( numrnf, 'socoefr', jpidta, jpjdta, 1, jpmois, nrnf1,   & 
    294             &          nrnf1, mig(1), nlci, mjg(1), nlcj, zcoefr(1:nlci,1:nlcj) ) 
    295  
    296          IF(lwp) WRITE(numout,*) 
    297          IF(lwp) WRITE(numout,*) ' read coefr for advection ok' 
    298          IF(lwp) WRITE(numout,*) 
    299           
    300          upsrnfh(:,:) = zcoefr(:,:) 
     244 
     245         CALL iom_get ( numrnf, jpdom_data, 'socoefr', upsrnfh ) 
     246          
    301247         upsrnfz(:)   = 0.e0 
    302248         upsrnfz(1)   = 1.0 
    … …  
    368314      ! -------------------- 
    369315 
    370       IF( kt == nitend .AND. nrunoff >= 1 )   CALL flinclo( numrnf ) 
     316      IF( kt == nitend .AND. nrunoff >= 1 )   CALL iom_close( numrnf ) 
    371317 
    372318   END SUBROUTINE flx_rnf 

  • trunk/NEMO/OFF_SRC/dtadyn.F90

    r446 r495  
    5454      nficdyn = 2       ! number of dynamical fields  
    5555 
    56    INTEGER :: ndyn1, ndyn2 , & 
     56   INTEGER ::     & 
     57      ndyn1, ndyn2 , & 
    5758      nlecoff = 0  , & ! switch for the first read 
    5859      numfl_t, numfl_u, & 
    59       numfl_v, numfl_w, numfl_s 
     60      numfl_v, numfl_w 
    6061       
    6162 
    … …  
    7677#endif 
    7778 
    78 #if defined key_traldf_eiv   &&   defined key_traldf_c2d 
     79#if ! defined key_off_degrad 
     80 
     81# if defined key_traldf_c2d 
    7982   REAL(wp), DIMENSION(jpi,jpj,2) ::   & 
    80       ahtwdta ,  & ! Lateral diffusivity 
    81       eivwdta      ! G&M coefficient 
    82 #endif 
     83      ahtwdta      ! Lateral diffusivity 
     84# if defined key_trcldf_eiv  
     85   REAL(wp), DIMENSION(jpi,jpj,2) ::   & 
     86      aeiwdta      ! G&M coefficient 
     87# endif 
     88# endif 
     89 
     90#else 
     91 
     92   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
     93      ahtudta, ahtvdta, ahtwdta  !  Lateral diffusivity 
     94# if defined key_trcldf_eiv 
     95   REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
     96      aeiudta, aeivdta, aeiwdta  ! G&M coefficient 
     97# endif 
     98 
     99#endif 
     100# if defined key_diaeiv 
     101   !! GM Velocity : to be used latter 
     102      REAL(wp), DIMENSION(jpi,jpj,jpk,2) ::   & 
     103        eivudta, eivvdta, eivwdta 
     104# endif 
    83105 
    84106   REAL(wp), DIMENSION(jpi,jpj,jpflx,2) ::   & 
    … …  
    167189      !!   ! addition  : 98-05 (L. Bopp read output of coupled run) 
    168190      !!   ! addition  : 05-03 (O. Aumont and A. El Moussaoui) F90 
     191      !!   ! addition  : 05-12 (C. Ethe) Adapted for DEGINT 
    169192      !!---------------------------------------------------------------------- 
    170193      !! * Modules used 
    … …  
    256279      ! DATA READ for the iperm1 period 
    257280      ! 
    258           IF( iperm1 .NE. 0 ) THEN 
     281          IF( iperm1 /= 0 ) THEN 
    259282             CALL dynrea( kt, iperm1 )  
    260283          ELSE  
    … …  
    267290                sn(:,:,:)=sdta(:,:,:,2) 
    268291                avt(:,:,:)=avtdta(:,:,:,2) 
     292 
    269293 
    270294         IF(lwp) THEN 
    … …  
    306330                flxdta(:,:,:,1) = flxdta(:,:,:,2) 
    307331                zmxldta(:,:,1)=zmxldta(:,:,2) 
    308 #if defined key_traldf_eiv   &&   defined key_traldf_c2d 
    309                 ahtwdta(:,:,1)=ahtwdta(:,:,2) 
    310                 eivwdta(:,:,1)=eivwdta(:,:,2) 
    311 #endif 
     332#if ! defined key_off_degrad 
     333 
     334#  if defined key_traldf_c2d 
     335                ahtwdta(:,:,1)= ahtwdta(:,:,2) 
     336#    if defined key_trcldf_eiv 
     337                aeiwdta(:,:,1)= aeiwdta(:,:,2) 
     338#    endif 
     339#  endif 
     340 
     341#else 
     342                ahtudta(:,:,:,1) = ahtudta(:,:,:,2) 
     343                ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2) 
     344                ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2) 
     345#  if defined key_trcldf_eiv 
     346                aeiudta(:,:,:,1) = aeiudta(:,:,:,2) 
     347                aeivdta(:,:,:,1) = aeivdta(:,:,:,2) 
     348                aeiwdta(:,:,:,1) = aeiwdta(:,:,:,2) 
     349#  endif 
     350 
     351#endif 
     352 
    312353#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    313354                bblxdta(:,:,1)=bblxdta(:,:,2) 
    … …  
    321362      ! DATA READ for the iper period 
    322363      ! 
    323           CALL dynrea(kt,iper) 
     364          CALL dynrea( kt, iper ) 
    324365      ! 
    325366      ! Computes wdta (and slopes if key_trahdfiso) 
    … …  
    369410      ! swap from record 2 to 1 
    370411      ! 
    371                 udta(:,:,:,1)=udta(:,:,:,2) 
    372                 vdta(:,:,:,1)=vdta(:,:,:,2) 
    373                 wdta(:,:,:,1)=wdta(:,:,:,2) 
    374                 avtdta(:,:,:,1)=avtdta(:,:,:,2) 
    375                 tdta(:,:,:,1)=tdta(:,:,:,2) 
    376                 sdta(:,:,:,1)=sdta(:,:,:,2) 
     412                udta(:,:,:,1) = udta(:,:,:,2) 
     413                vdta(:,:,:,1) = vdta(:,:,:,2) 
     414                wdta(:,:,:,1)= wdta(:,:,:,2) 
     415                avtdta(:,:,:,1) = avtdta(:,:,:,2) 
     416                tdta(:,:,:,1) = tdta(:,:,:,2) 
     417                sdta(:,:,:,1) = sdta(:,:,:,2) 
    377418#if defined key_ldfslp 
    378                 uslpdta(:,:,:,1)=uslpdta(:,:,:,2) 
    379                 vslpdta(:,:,:,1)=vslpdta(:,:,:,2) 
    380                 wslpidta(:,:,:,1)=wslpidta(:,:,:,2) 
    381                 wslpjdta(:,:,:,1)=wslpjdta(:,:,:,2) 
     419                uslpdta(:,:,:,1) = uslpdta(:,:,:,2) 
     420                vslpdta(:,:,:,1) = vslpdta(:,:,:,2) 
     421                wslpidta(:,:,:,1) = wslpidta(:,:,:,2) 
     422                wslpjdta(:,:,:,1) = wslpjdta(:,:,:,2) 
    382423#endif 
    383424                flxdta(:,:,:,1) = flxdta(:,:,:,2) 
    384                 zmxldta(:,:,1)=zmxldta(:,:,2) 
    385 #if defined key_traldf_eiv   &&   defined key_traldf_c2d 
    386                 ahtwdta(:,:,1)=ahtwdta(:,:,2) 
    387                 eivwdta(:,:,1)=eivwdta(:,:,2) 
    388 #endif 
     425                zmxldta(:,:,1) = zmxldta(:,:,2) 
     426 
     427#if ! defined key_off_degrad 
     428 
     429#  if defined key_traldf_c2d 
     430                ahtwdta(:,:,1)= ahtwdta(:,:,2) 
     431#    if defined key_trcldf_eiv 
     432                aeiwdta(:,:,1)= aeiwdta(:,:,2) 
     433#    endif 
     434#  endif 
     435 
     436#else 
     437                ahtudta(:,:,:,1) = ahtudta(:,:,:,2) 
     438                ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2) 
     439                ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2) 
     440#  if defined key_trcldf_eiv 
     441                aeiudta(:,:,:,1) = aeiudta(:,:,:,2) 
     442                aeivdta(:,:,:,1) = aeivdta(:,:,:,2) 
     443                aeiwdta(:,:,:,1) = aeiwdta(:,:,:,2) 
     444#  endif 
     445 
     446#endif 
     447 
    389448#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    390                 bblxdta(:,:,1)=bblxdta(:,:,2) 
    391                 bblydta(:,:,1)=bblydta(:,:,2) 
     449                bblxdta(:,:,1) = bblxdta(:,:,2) 
     450                bblydta(:,:,1) = bblydta(:,:,2) 
    392451#endif 
    393452      ! 
    … …  
    398457      ! READ DATA for the iper period 
    399458      ! 
    400           CALL dynrea(kt,iper) 
     459          CALL dynrea( kt, iper ) 
    401460      ! 
    402461      ! Computes wdta (and slopes if key_trahdfiso) 
    … …  
    423482          ndyn2 = iper 
    424483       ! 
    425        ! we have READ another period of DATA 
    426        ! 
     484       ! we have READ another period of DATA       ! 
    427485          IF (lwp) THEN 
    428486              WRITE (numout,*) ' dynamics DATA READ for the period ndyn1 =',ndyn1 
    … …  
    436494      ! compute the DATA at the given time step 
    437495      ! 
    438       IF (nsptint.eq.0) THEN 
     496      IF ( nsptint == 0 ) THEN 
    439497      ! 
    440498      ! no spatial interpolation 
    … …  
    464522                    flx(:,:,:) = flxdta(:,:,:,2) 
    465523                    hmld(:,:)=zmxldta(:,:,2) 
    466 #if defined key_traldf_eiv   &&   defined key_traldf_c2d 
    467                     ahtw(:,:)=ahtwdta(:,:,2) 
    468                     aeiw(:,:)=eivwdta(:,:,2) 
    469 #endif 
     524#if ! defined key_off_degrad 
     525 
     526#  if defined key_traldf_c2d 
     527                ahtwdta(:,:,1)= ahtwdta(:,:,2) 
     528#    if defined key_trcldf_eiv 
     529                aeiwdta(:,:,1)= aeiwdta(:,:,2) 
     530#    endif 
     531#  endif 
     532 
     533#else 
     534                ahtudta(:,:,:,1) = ahtudta(:,:,:,2) 
     535                ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2) 
     536                ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2) 
     537#  if defined key_trcldf_eiv 
     538                aeiudta(:,:,:,1) = aeiudta(:,:,:,2) 
     539                aeivdta(:,:,:,1) = aeivdta(:,:,:,2) 
     540                aeiwdta(:,:,:,1) = aeiwdta(:,:,:,2) 
     541#  endif 
     542 
     543#endif 
     544 
    470545#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    471546                    bblx(:,:)=bblxdta(:,:,2) 
    … …  
    486561 
    487562      ELSE  
    488           IF (nsptint.eq.1) THEN 
     563          IF ( nsptint == 1 ) THEN 
    489564      ! 
    490565      ! linear interpolation 
    … …  
    511586                    flx(:,:,:) = zweighm1 * flxdta(:,:,:,1) + zweigh * flxdta(:,:,:,2)  
    512587                    hmld(:,:) = zweighm1 * zmxldta(:,:,1) + zweigh  * zmxldta(:,:,2)  
    513 #if defined key_traldf_eiv   &&   defined key_traldf_c2d 
    514                     ahtw(:,:) =  zweighm1 * ahtwdta(:,:,1) + zweigh * ahtwdta(:,:,2) 
    515                     aeiw(:,:) =  zweighm1 * eivwdta(:,:,1) + zweigh * eivwdta(:,:,2) 
    516 #endif 
     588#if ! defined key_off_degrad 
     589 
     590#  if defined key_traldf_c2d 
     591                    ahtw(:,:) = zweighm1 * ahtwdta(:,:,1) + zweigh * ahtwdta(:,:,2) 
     592#    if defined key_trcldf_eiv 
     593                    aeiw(:,:) = zweighm1 * aeiwdta(:,:,1) + zweigh * aeiwdta(:,:,2) 
     594#    endif 
     595#  endif 
     596 
     597#else 
     598                    ahtu(:,:,:) = zweighm1 * ahtudta(:,:,:,1) + zweigh * ahtudta(:,:,:,2) 
     599                    ahtv(:,:,:) = zweighm1 * ahtvdta(:,:,:,1) + zweigh * ahtvdta(:,:,:,2) 
     600                    ahtw(:,:,:) = zweighm1 * ahtwdta(:,:,:,1) + zweigh * ahtwdta(:,:,:,2) 
     601#  if defined key_trcldf_eiv 
     602                    aeiu(:,:,:) = zweighm1 * aeiudta(:,:,:,1) + zweigh * aeiudta(:,:,:,2) 
     603                    aeiv(:,:,:) = zweighm1 * aeivdta(:,:,:,1) + zweigh * aeivdta(:,:,:,2) 
     604                    aeiw(:,:,:) = zweighm1 * aeiwdta(:,:,:,1) + zweigh * aeiwdta(:,:,:,2) 
     605#  endif 
     606                     
     607#endif 
     608 
    517609#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    518                     bblx(:,:)= zweighm1 * bblxdta(:,:,1) + zweigh * bblxdta(:,:,2) 
    519                     bbly(:,:)= zweighm1 * bblydta(:,:,1) + zweigh * bblydta(:,:,2) 
     610                    bblx(:,:) = zweighm1 * bblxdta(:,:,1) + zweigh * bblxdta(:,:,2) 
     611                    bbly(:,:) = zweighm1 * bblydta(:,:,1) + zweigh * bblydta(:,:,2) 
    520612#endif 
    521613       ! 
    … …  
    526618#endif 
    527619                  freeze(:,:) = flx(:,:,jpice) 
    528                   emp(:,:) = flx(:,:,jpemp) 
    529                   emps(:,:) = emp(:,:) 
    530                   qsr(:,:) = flx(:,:,jpqsr) 
     620                  emp(:,:)    = flx(:,:,jpemp) 
     621                  emps(:,:)   = emp(:,:) 
     622                  qsr(:,:)    = flx(:,:,jpqsr) 
    531623       ! 
    532624       ! other interpolation 
    … …  
    546638      CALL eos( tn, sn, rhd, rhop )  
    547639 
    548 #if defined key_traldf_c2d 
     640#if ! defined key_off_degrad && defined key_traldf_c2d 
    549641      ! In case of 2D varying coefficients, we need aeiv and aeiu 
    550642      IF( lk_traldf_eiv )   CALL ldf_eiv( kt )      ! eddy induced velocity coefficient 
    … …  
    565657      !!              (netcdf FORMAT)  
    566658      !!              05-03 (O. Aumont and A. El Moussaoui) F90 
     659      !!              06-07 : (C. Ethe) use of iom module 
    567660      !!---------------------------------------------------------------------- 
    568661      !! * Modules used 
    569       USE ioipsl 
     662      USE iom 
    570663 
    571664      !! * Arguments 
    572665      INTEGER, INTENT( in ) ::   kt, kenr       ! time index 
    573666      !! * Local declarations 
    574       INTEGER ::   ji, jj 
    575       INTEGER ::   ipi,ipj,ipk,itime,jkenr,idtatot 
    576       INTEGER , DIMENSION(ndtatot) :: istep 
    577  
    578       REAL(wp) ::  zdate0 
     667      INTEGER ::  ji, jj, jk, jkenr 
    579668 
    580669      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    581         zu, zv, zw, zt, zs, zavt ! 3-D dynamical fields 
    582  
    583 # if defined key_traldf_eiv 
    584       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
    585         zaeiu, zaeiv, zaeiw 
    586 # endif 
    587  
    588 # if defined key_traldf_eiv   &&   defined key_traldf_c2d 
    589       REAL(wp), DIMENSION(jpi,jpj) ::   & 
    590         zeivw, zahtw 
    591 # endif 
     670        zu, zv, zw, zt, zs, zavt ,   &     ! 3-D dynamical fields 
     671        zhdiv                              ! horizontal divergence 
    592672 
    593673      REAL(wp), DIMENSION(jpi,jpj) :: & 
    594         zlon, zlat, zemp, zqsr, zmld, zice, zwind  
     674         zemp, zqsr, zmld, zice, zwspd  
    595675#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    596676      REAL(wp), DIMENSION(jpi,jpj) :: & 
    597677        zbblx, zbbly 
    598678#endif 
    599       REAL(wp), DIMENSION(jpk) :: zlev 
     679 
     680#if ! defined key_off_degrad 
     681 
     682#  if defined key_traldf_c2d 
     683      REAL(wp), DIMENSION(jpi,jpj) ::   & 
     684         zahtw 
     685#   if defined key_trcldf_eiv 
     686      REAL(wp), DIMENSION(jpi,jpj) ::   & 
     687         zaeiw 
     688#   endif 
     689#  endif 
     690 
     691#else 
     692 
     693   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
     694      zahtu, zahtv, zahtw  !  Lateral diffusivity 
     695# if defined key_trcldf_eiv 
     696   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
     697      zaeiu, zaeiv, zaeiw  ! G&M coefficient 
     698# endif 
     699 
     700#endif 
     701 
     702# if defined key_diaeiv 
     703   !! GM Velocity : to be used latter 
     704      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
     705        zeivu, zeivv, zeivw 
     706# endif 
    600707 
    601708      CHARACTER(len=45)  ::  & 
    … …  
    603710         clname_u = 'dyna_grid_U.nc', & 
    604711         clname_v = 'dyna_grid_V.nc', & 
    605          clname_w = 'dyna_grid_W.nc', & 
    606          clname_s = 'dyna_wspd.nc' 
     712         clname_w = 'dyna_grid_W.nc' 
    607713      ! 
    608714      ! 0. Initialization 
    … …  
    616722         WRITE(numout,*) 'Dynrea : reading dynamical fields, kenr = ', jkenr 
    617723         WRITE(numout,*) ' ~~~~~~~' 
     724#if defined key_off_degrad 
     725         WRITE(numout,*) ' Degraded fields' 
     726#endif 
    618727         WRITE(numout,*) 
    619728      ENDIF 
    620729 
    621730 
     731      IF( kt == nit000 .AND. nlecoff == 0 ) THEN 
     732 
     733         nlecoff = 1 
     734 
     735         CALL  iom_open ( clname_t, numfl_t ) 
     736         CALL  iom_open ( clname_u, numfl_u ) 
     737         CALL  iom_open ( clname_v, numfl_v ) 
     738         CALL  iom_open ( clname_w, numfl_w ) 
     739 
     740      ENDIF 
     741 
     742      ! file grid-T 
     743      !--------------- 
     744      CALL iom_get ( numfl_t, jpdom_data, 'votemper', zt   (:,:,:), jkenr ) 
     745      CALL iom_get ( numfl_t, jpdom_data, 'vosaline', zs   (:,:,:), jkenr ) 
     746      CALL iom_get ( numfl_t, jpdom_data, 'somixhgt', zmld (:,:  ), jkenr ) 
     747      CALL iom_get ( numfl_t, jpdom_data, 'sowaflup', zemp (:,:  ), jkenr ) 
     748      CALL iom_get ( numfl_t, jpdom_data, 'soshfldo', zqsr (:,:  ), jkenr ) 
     749      CALL iom_get ( numfl_t, jpdom_data, 'soicecov', zice (:,:  ), jkenr ) 
     750      CALL iom_get ( numfl_t, jpdom_data, 'sowindsp', zwspd(:,:  ), jkenr ) 
     751 
     752      ! file grid-U 
     753      !--------------- 
     754      CALL iom_get ( numfl_u, jpdom_data, 'vozocrtx', zu   (:,:,:), jkenr ) 
     755#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
     756      CALL iom_get ( numfl_u, jpdom_data, 'sobblcox', zbblx(:,:  ), jkenr ) 
     757#endif 
     758 
     759#if defined key_diaeiv 
     760      !! GM Velocity : to be used latter 
     761      CALL iom_get ( numfl_u, jpdom_data, 'vozoeivu', zeivu(:,:,:), jkenr ) 
     762#endif 
     763 
     764# if defined key_off_degrad 
     765      CALL iom_get ( numfl_u, jpdom_data, 'vozoahtu', zahtu(:,:,:), jkenr ) 
     766# if defined key_trcldf_eiv 
     767      CALL iom_get ( numfl_u, jpdom_data, 'vozoaeiu', zaeiu(:,:,:), jkenr ) 
     768# endif 
     769#endif 
     770 
     771      ! file grid-V 
     772      !--------------- 
     773      CALL iom_get ( numfl_v, jpdom_data, 'vomecrty', zv   (:,:,:), jkenr ) 
     774#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
     775      CALL iom_get ( numfl_v, jpdom_data, 'sobblcoy', zbbly(:,:  ), jkenr ) 
     776#endif 
     777 
     778#if defined key_diaeiv 
     779      !! GM Velocity : to be used latter 
     780      CALL iom_get ( numfl_v, jpdom_data, 'vomeeivv', zeivv(:,:,:), jkenr ) 
     781#endif 
     782 
     783#if defined key_off_degrad 
     784      CALL iom_get ( numfl_v, jpdom_data, 'vomeahtv', zahtv(:,:,:), jkenr ) 
     785#   if defined key_trcldf_eiv 
     786      CALL iom_get ( numfl_v, jpdom_data, 'vomeaeiv', zaeiv(:,:,:), jkenr ) 
     787#   endif 
     788#endif 
     789 
     790      ! file grid-W 
     791      !--------------- 
     792!!      CALL iom_get ( numfl_w, jpdom_data, 'vovecrtz', zw   (:,:,:), jkenr ) 
     793# if defined key_zdfddm 
     794      CALL iom_get ( numfl_w, jpdom_data, 'voddmavs', zavt (:,:,:), jkenr ) 
     795#else 
     796      CALL iom_get ( numfl_w, jpdom_data, 'votkeavt', zavt (:,:,:), jkenr ) 
     797#endif  
     798 
     799# if defined key_diaeiv 
     800      !! GM Velocity : to be used latter 
     801      CALL iom_get ( numfl_w, jpdom_data, 'voveeivw', zeivw(:,:,:), jkenr ) 
     802#endif  
     803 
     804#if ! defined key_off_degrad 
     805#  if defined key_traldf_c2d 
     806      CALL iom_get ( numfl_w, jpdom_data, 'soleahtw', zahtw (:,: ), jkenr ) 
     807#   if   defined key_traldf_eiv  
     808      CALL iom_get ( numfl_w, jpdom_data, 'soleaeiw', zaeiw (:,: ), jkenr ) 
     809#   endif 
     810#  endif 
     811#else 
     812      !! degradation-integration 
     813      CALL iom_get ( numfl_w, jpdom_data, 'voveahtw', zahtw(:,:,:), jkenr ) 
     814# if defined key_trcldf_eiv 
     815      CALL iom_get ( numfl_w, jpdom_data, 'voveaeiw', zaeiw(:,:,:), jkenr ) 
     816# endif 
     817#endif 
     818 
     819      udta(:,:,:,2) = zu(:,:,:) * umask(:,:,:) 
     820      vdta(:,:,:,2) = zv(:,:,:) * vmask(:,:,:) 
     821!!       wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:) 
     822 
     823 
     824      ! Computation of vertical velocity using horizontal divergence 
     825      zhdiv(:,:,:) = 0. 
     826      DO jk = 1, jpkm1 
     827         DO jj = 2, jpjm1 
     828            DO ji = fs_2, fs_jpim1   ! vector opt. 
     829               zhdiv(ji,jj,jk) = ( e2u(ji,jj) * udta(ji,jj,jk,2) - e2u(ji-1,jj) * udta(ji-1,jj,jk,2)      & 
     830                  &               + e1v(ji,jj) * vdta(ji,jj,jk,2) - e1v(ji,jj-1) * vdta(ji,jj-1,jk,2) )   & 
     831                  &            / ( e1t(ji,jj) * e2t(ji,jj) ) 
     832            END DO 
     833         END DO 
     834      END DO 
    622835       
    623       idtatot = ndtatot 
    624  
    625       IF( kt == nit000 .AND. nlecoff == 0 ) THEN 
    626  
    627          nlecoff = 1 
    628  
    629          CALL flinopen(clname_t,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, & 
    630             &  ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numfl_t) 
    631  
    632          IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 
    633             IF(lwp) THEN 
    634                WRITE(numout,*) 
    635                WRITE(numout,*) 'problem with dimensions' 
    636                WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
    637                WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
    638                WRITE(numout,*) ' ipk ',ipk,' jpk    ',jpk 
    639             ENDIF 
    640             STOP 'dynrea  ' 
    641          ENDIF 
    642  
    643          CALL flinopen(clname_u,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, & 
    644             &  ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numfl_u) 
    645  
    646          IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 
    647             IF(lwp) THEN 
    648                WRITE(numout,*) 
    649                WRITE(numout,*) 'problem with dimensions' 
    650                WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
    651                WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
    652                WRITE(numout,*) ' ipk ',ipk,' jpk    ',jpk 
    653             ENDIF 
    654             STOP 'dynrea  ' 
    655          ENDIF 
    656  
    657          CALL flinopen(clname_v,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, & 
    658             &  ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numfl_v) 
    659  
    660          IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 
    661             IF(lwp) THEN 
    662                WRITE(numout,*) 
    663                WRITE(numout,*) 'problem with dimensions' 
    664                WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
    665                WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
    666                WRITE(numout,*) ' ipk ',ipk,' jpk    ',jpk 
    667             ENDIF 
    668             STOP 'dynrea ' 
    669          ENDIF 
    670  
    671          CALL flinopen(clname_w,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, & 
    672             &  ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numfl_w) 
    673  
    674          IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 
    675             IF(lwp) THEN 
    676                WRITE(numout,*) 
    677                WRITE(numout,*) 'problem with dimensions' 
    678                WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
    679                WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
    680                WRITE(numout,*) ' ipk ',ipk,' jpk    ',jpk 
    681             ENDIF 
    682             STOP 'dynrea ' 
    683          ENDIF 
    684  
    685          CALL flinopen(clname_s,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj, & 
    686             &  ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numfl_s) 
    687  
    688          IF( ipi /= jpidta .OR. ipj /= jpjdta  ) THEN 
    689             IF(lwp) THEN 
    690                WRITE(numout,*) 
    691                WRITE(numout,*) 'problem with dimensions' 
    692                WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
    693                WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
    694             ENDIF 
    695             STOP 'dynrea' 
    696          ENDIF 
    697  
     836      zw(:,:,jpk) = 0. 
     837 
     838      ! Computation from the bottom 
     839      DO jk = jpkm1, 1, -1 
     840         zw(:,:,jk) = zw(:,:,jk+1) - fse3t(:,:,jk) * zhdiv(:,:,jk) 
     841      END DO 
     842      wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:) 
     843 
     844 
     845      tdta(:,:,:,2)   = zt(:,:,:)   * tmask(:,:,:) 
     846      sdta(:,:,:,2)   = zs(:,:,:)   * tmask(:,:,:) 
     847      avtdta(:,:,:,2) = zavt(:,:,:) * tmask(:,:,:) 
     848#if ! defined key_off_degrad && defined key_traldf_c2d 
     849      ahtwdta(:,:,2)  = zahtw(:,:) * tmask(:,:,1) 
     850#if defined key_traldf_eiv 
     851      aeiwdta(:,:,2)  = zaeiw(:,:) * tmask(:,:,1) 
     852#endif 
     853#endif 
     854 
     855#if defined key_off_degrad 
     856        ahtudta(:,:,:,2) = zahtu(:,:,:) * umask(:,:,:) 
     857        ahtvdta(:,:,:,2) = zahtv(:,:,:) * vmask(:,:,:) 
     858        ahtwdta(:,:,:,2) = zahtw(:,:,:) * tmask(:,:,:) 
     859#  if defined key_trcldf_eiv 
     860        aeiudta(:,:,:,2) = zaeiu(:,:,:) * umask(:,:,:) 
     861        aeivdta(:,:,:,2) = zaeiv(:,:,:) * vmask(:,:,:) 
     862        aeiwdta(:,:,:,2) = zaeiw(:,:,:) * tmask(:,:,:) 
     863#  endif 
     864#endif 
     865 
     866      ! 
     867      ! flux : 
     868      ! 
     869      flxdta(:,:,jpwind,2) = zwspd(:,:) * tmask(:,:,1) 
     870      flxdta(:,:,jpice,2)  = MIN( 1., zice(:,:) ) * tmask(:,:,1) 
     871      flxdta(:,:,jpemp,2)  = zemp(:,:) * tmask(:,:,1) 
     872      flxdta(:,:,jpqsr,2)  = zqsr(:,:) * tmask(:,:,1) 
     873      zmxldta(:,:,2)       = zmld(:,:) * tmask(:,:,1) 
     874       
     875#if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
     876      bblxdta(:,:,2) = MAX( 0., zbblx(:,:) ) 
     877      bblydta(:,:,2) = MAX( 0., zbbly(:,:) ) 
     878 
     879      WHERE( bblxdta(:,:,2) > 2. ) bblxdta(:,:,2) = 0. 
     880      WHERE( bblydta(:,:,2) > 2. ) bblydta(:,:,2) = 0. 
     881 
     882#endif 
     883 
     884      IF( kt == nitend ) THEN 
     885         CALL iom_close ( numfl_t ) 
     886         CALL iom_close ( numfl_u ) 
     887         CALL iom_close ( numfl_v ) 
     888         CALL iom_close ( numfl_w ) 
    698889      ENDIF 
    699  
    700       CALL flinget(numfl_u,'vozocrtx',jpidta,jpjdta,jpk,idtatot,jkenr,   & 
    701          &         jkenr,mig(1),nlci,mjg(1),nlcj,zu(1:nlci,1:nlcj,1:jpk)) 
    702  
    703 #if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    704       CALL flinget(numfl_u,'sobblcox',jpidta,jpjdta,1,idtatot,jkenr,  & 
    705          &        jkenr,mig(1),nlci,mjg(1),nlcj,zbblx(1:nlci,1:nlcj)) 
    706 #endif 
    707  
    708 # if defined key_traldf_eiv 
    709       CALL flinget(numfl_u,'vozoeivu',jpidta,jpjdta,jpk,idtatot,jkenr,   & 
    710          &        jkenr,mig(1),nlci,mjg(1),nlcj,zaeiu(1:nlci,1:nlcj,1:jpk)) 
    711 #endif 
    712  
    713       CALL flinget(numfl_v,'vomecrty',jpidta,jpjdta,jpk,idtatot,jkenr,   & 
    714          &        jkenr,mig(1),nlci,mjg(1),nlcj,zv(1:nlci,1:nlcj,1:jpk)) 
    715  
    716 #if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    717       CALL flinget(numfl_v,'sobblcoy',jpidta,jpjdta,1,idtatot,jkenr,  & 
    718          &        jkenr,mig(1),nlci,mjg(1),nlcj,zbbly(1:nlci,1:nlcj)) 
    719 #endif 
    720  
    721 # if defined key_traldf_eiv 
    722       CALL flinget(numfl_v,'vomeeivv',jpidta,jpjdta,jpk,idtatot,jkenr,   & 
    723          &        jkenr,mig(1),nlci,mjg(1),nlcj,zaeiv(1:nlci,1:nlcj,1:jpk)) 
    724 #endif 
    725  
    726       CALL flinget(numfl_w,'vovecrtz',jpidta,jpjdta,jpk,idtatot,jkenr,   & 
    727          &        jkenr,mig(1),nlci,mjg(1),nlcj,zw(1:nlci,1:nlcj,1:jpk)) 
    728  
    729 # if defined key_traldf_eiv 
    730       CALL flinget(numfl_w,'voveeivw',jpidta,jpjdta,jpk,idtatot,jkenr,   & 
    731          &        jkenr,mig(1),nlci,mjg(1),nlcj,zaeiw(1:nlci,1:nlcj,1:jpk)) 
    732 #endif 
    733  
    734  
    735 #if defined key_zdfddm 
    736       CALL flinget(numfl_w,'voddmavs',jpidta,jpjdta,jpk,idtatot,jkenr,   & 
    737          &        jkenr,mig(1),nlci,mjg(1),nlcj,zavt(1:nlci,1:nlcj,1:jpk)) 
    738 #else 
    739       CALL flinget(numfl_w,'votkeavt',jpidta,jpjdta,jpk,idtatot,jkenr,   & 
    740          &        jkenr,mig(1),nlci,mjg(1),nlcj,zavt(1:nlci,1:nlcj,1:jpk)) 
    741 #endif 
    742  
    743 #if   defined key_traldf_eiv   &&   defined key_traldf_c2d 
    744       CALL flinget(numfl_w,'soleahtw',jpidta,jpjdta,1,idtatot,jkenr,   & 
    745                   jkenr,mig(1),nlci,mjg(1),nlcj,zahtw(1:nlci,1:nlcj)) 
    746  
    747       CALL flinget(numfl_w,'soleaeiw',jpidta,jpjdta,1,idtatot,jkenr,   & 
    748                   jkenr,mig(1),nlci,mjg(1),nlcj,zeivw(1:nlci,1:nlcj)) 
    749 #endif 
    750  
    751       CALL flinget(numfl_t,'votemper',jpidta,jpjdta,jpk,idtatot,jkenr,   & 
    752          &        jkenr,mig(1),nlci,mjg(1),nlcj,zt(1:nlci,1:nlcj,1:jpk)) 
    753  
    754       CALL flinget(numfl_t,'vosaline',jpidta,jpjdta,jpk,idtatot,jkenr,   & 
    755          &        jkenr,mig(1),nlci,mjg(1),nlcj,zs(1:nlci,1:nlcj,1:jpk)) 
    756  
    757       CALL flinget(numfl_t,'somixhgt',jpidta,jpjdta,1,idtatot,jkenr,  & 
    758          &        jkenr,mig(1),nlci,mjg(1),nlcj,zmld(1:nlci,1:nlcj)) 
    759  
    760  
    761       CALL flinget(numfl_t,'sowaflup',jpidta,jpjdta,1,idtatot,jkenr,  & 
    762          &         jkenr,mig(1),nlci,mjg(1),nlcj,zemp(1:nlci,1:nlcj)) 
    763  
    764       CALL flinget(numfl_t,'soshfldo',jpidta,jpjdta,1,idtatot,jkenr,  & 
    765          &        jkenr,mig(1),nlci,mjg(1),nlcj,zqsr(1:nlci,1:nlcj)) 
    766  
    767       CALL flinget(numfl_t,'soicecov',jpidta,jpjdta,1,idtatot,jkenr,  & 
    768          &        jkenr,mig(1),nlci,mjg(1),nlcj,zice(1:nlci,1:nlcj)) 
    769  
    770       CALL flinget(numfl_s,'wspd',    jpidta,jpjdta,1,idtatot,jkenr,   & 
    771          &        jkenr,mig(1),nlci,mjg(1),nlcj,zwind(1:nlci,1:nlcj)) 
    772   
    773  
    774         ! Extra-halo initialization in MPP 
    775          IF( lk_mpp ) THEN 
    776             DO ji = nlci+1, jpi 
    777                zu(ji,:,:) = zu(1,:,:)    
    778                zv(ji,:,:) = zv(1,:,:)    
    779                zw(ji,:,:) = zw(1,:,:)    
    780                zavt(ji,:,:)=zavt(1,:,:) 
    781                zt(ji,:,:)=zt(1,:,:) 
    782                zs(ji,:,:)=zs(1,:,:) 
    783                zmld(ji,:)=zmld(1,:) 
    784                zwind(ji,:)=zwind(1,:) 
    785                zemp(ji,:)=zemp(1,:) 
    786                zqsr(ji,:)=zqsr(1,:) 
    787                zice(ji,:)=zice(1,:) 
    788 #if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    789                zbblx(ji,:)=zbblx(1,:) 
    790                zbbly(ji,:)=zbbly(1,:) 
    791 #endif 
    792 #if defined key_traldf_eiv 
    793                zaeiu(ji,:,:)=zaeiu(1,:,:) 
    794                zaeiv(ji,:,:)=zaeiv(1,:,:) 
    795                zaeiw(ji,:,:)=zaeiw(1,:,:) 
    796 #endif 
    797 #if defined key_traldf_eiv   &&   defined key_traldf_c2d 
    798                zahtw(ji,:)=zahtw(1,:) 
    799                zeivw(ji,:)=zeivw(1,:) 
    800 #endif 
    801             ENDDO 
    802             DO jj = nlcj+1, jpj 
    803                zu(:,jj,:) = zu(:,1,:) 
    804                zv(:,jj,:) = zv(:,1,:) 
    805                zw(:,jj,:) = zw(:,1,:) 
    806                zavt(:,jj,:)=zavt(:,1,:) 
    807                zt(:,jj,:)=zt(:,1,:) 
    808                zs(:,jj,:)=zs(:,1,:) 
    809                zmld(:,jj)=zmld(:,1) 
    810                zwind(:,jj)=zwind(:,1) 
    811                zemp(:,jj)=zemp(:,1) 
    812                zqsr(:,jj)=zqsr(:,1) 
    813                zice(:,jj)=zice(:,1) 
    814 #if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    815                zbblx(:,jj)=zbblx(:,1) 
    816                zbbly(:,jj)=zbbly(:,1) 
    817 #endif 
    818 #if defined key_traldf_eiv 
    819                zaeiu(:,jj,:)=zaeiu(:,1,:) 
    820                zaeiv(:,jj,:)=zaeiv(:,1,:) 
    821                zaeiw(:,jj,:)=zaeiw(:,1,:) 
    822 #endif 
    823 #if defined key_traldf_eiv   &&   defined key_traldf_c2d 
    824                zahtw(:,jj)=zahtw(:,1) 
    825                zeivw(:,jj)=zeivw(:,1) 
    826 #endif 
    827             ENDDO 
    828          ENDIF 
    829  
    830  
    831             udta(:,:,:,2)=zu(:,:,:)*umask(:,:,:) 
    832             vdta(:,:,:,2)=zv(:,:,:)*vmask(:,:,:) 
    833             wdta(:,:,:,2)=zw(:,:,:)*tmask(:,:,:) 
    834             tdta(:,:,:,2)=zt(:,:,:)*tmask(:,:,:) 
    835             sdta(:,:,:,2)=zs(:,:,:)*tmask(:,:,:) 
    836             avtdta(:,:,:,2)=zavt(:,:,:)*tmask(:,:,:) 
    837 #if defined key_traldf_eiv   &&   defined key_traldf_c2d 
    838             ahtwdta(:,:,2)=zahtw(:,:)*tmask(:,:,1) 
    839             eivwdta(:,:,2)=zeivw(:,:)*tmask(:,:,1) 
    840 #endif 
    841       ! 
    842       ! 
    843       ! flux : 
    844       ! 
    845             flxdta(:,:,jpwind,2)=zwind(:,:)*tmask(:,:,1) 
    846             flxdta(:,:,jpice,2)=min(1.,zice(:,:))*tmask(:,:,1) 
    847             flxdta(:,:,jpemp,2)=zemp(:,:)*tmask(:,:,1) 
    848             flxdta(:,:,jpqsr,2)=zqsr(:,:)*tmask(:,:,1) 
    849             zmxldta(:,:,2)=zmld(:,:)*tmask(:,:,1) 
    850  
    851 #if defined key_trcbbl_dif   ||   defined key_trcbbl_adv 
    852             bblxdta(:,:,2)=max(0.,zbblx(:,:)) 
    853             bblydta(:,:,2)=max(0.,zbbly(:,:)) 
    854  
    855         DO ji=1,jpi 
    856           DO jj=1,jpj 
    857             if (bblxdta(ji,jj,2).gt.2.) bblxdta(ji,jj,2)=0. 
    858             if (bblydta(ji,jj,2).gt.2.) bblydta(ji,jj,2)=0. 
    859           END DO 
    860         END DO 
    861 #endif 
    862  
     890       
    863891   END SUBROUTINE dynrea 
    864892 

  • trunk/NEMO/OFF_SRC/mppini_2.h90

    r325 r495  
    4040      !!---------------------------------------------------------------------- 
    4141      !! * Modules used 
    42       USE ioipsl 
    43  
     42      USE iom 
     43    
    4444      !! Local variables 
    45       CHARACTER (len=25) ::               &  ! temporary name 
    46                 clname , clvar               ! filename and cdf variable name for bathy 
    47       LOGICAL ::   llbon                      ! check the existence of bathy files 
    4845      INTEGER :: ji, jj, jn, jproc, jarea     ! dummy loop indices 
    49       INTEGER ::   inum = 11                  ! temporary logical unit 
     46      INTEGER ::  inum                        ! temporary logical unit 
    5047      INTEGER ::   & 
    5148         ii, ij, ifreq, il1, il2,          &  ! temporary integers 
    … …  
    6663         ione  , ionw  , iose  , iosw  ,   &  !    "           " 
    6764         ibne  , ibnw  , ibse  , ibsw         !    "           " 
    68       INTEGER  ::   & 
    69          ipi, ipj, ipk,              &  ! temporary integers 
    70          itime                          !    "          " 
    71       INTEGER, DIMENSION (1) ::   istep 
    72  
    73       INTEGER, DIMENSION(jpiglo,jpjglo) ::   & 
     65      INTEGER, DIMENSION(jpi,jpj) ::   & 
    7466         imask                                ! temporary global workspace 
    75  
    76       REAL(wp), DIMENSION(jpidta,jpjdta) ::   & 
    77          zlamt, zphit, zdta                   ! temporary data workspace 
    78       REAL(wp), DIMENSION(jpk) ::   &    
    79          zdept                                ! temporary workspace (NetCDF read) 
    80       REAL(wp) ::   zidom , zjdom,   &        ! temporary scalars 
    81          zdt, zdate0 
     67      REAL(wp), DIMENSION(jpi,jpj) ::   & 
     68         zdta                   ! temporary data workspace 
     69      REAL(wp) ::   zidom , zjdom          ! temporary scalars 
    8270 
    8371      !!---------------------------------------------------------------------- 
    … …  
    10391#endif 
    10492 
    105  
    106       IF( jpni*jpnj < jpnij ) THEN 
    107          IF(lwp) WRITE(numout,cform_err) 
    108          IF(lwp) WRITE(numout,*) ' jpnij > jpni x jpnj impossible' 
    109          nstop = nstop + 1 
    110       ENDIF 
    111  
     93      IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' ) 
    11294 
    11395      ! 0. initialisation 
    … …  
    11597 
    11698      ! open the file 
    117          IF ( lk_zps ) THEN  
    118             clname = 'bathy_meter.nc'         ! Meter bathy in case of partial steps 
    119             clvar = 'Bathymetry' 
    120          ELSE 
    121             clname = 'bathy_level.nc'                       ! Level bathymetry 
    122             clvar = 'Bathy_level' 
    123          ENDIF 
    124  
    125          INQUIRE( FILE=clname, EXIST=llbon ) 
    126       IF( llbon ) THEN 
    127             IF(lwp) WRITE(numout,*) 
    128             IF(lwp) WRITE(numout,*) '         read bathymetry in ', clname 
    129             IF(lwp) WRITE(numout,*) 
    130             itime = 1 
    131             ipi = jpidta 
    132             ipj = jpjdta 
    133             ipk = 1 
    134             zdt = rdt 
    135  
    136             CALL flinopen( clname, 1, jpidta, 1, jpjdta, .FALSE.,   & 
    137                            ipi, ipj, ipk, zlamt, zphit, zdept, itime, istep, zdate0, zdt, inum ) 
    138             CALL flinget( inum, clvar, jpidta, jpjdta, 1,   & 
    139                           itime, 1, 1, 1, jpidta, 1, jpjdta, zdta(:,:) ) 
    140             CALL flinclo( inum ) 
    141       ELSE 
    142          IF(lwp) WRITE(numout,cform_err) 
    143          IF(lwp) WRITE(numout,*)'    mppini_2 : unable to read the file ', clname 
    144          nstop = nstop + 1 
    145       ENDIF 
     99      IF ( ln_zps ) THEN 
     100         CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps 
     101         CALL iom_get ( inum, jpdom_data, 'Bathymetry' , zdta ) 
     102      ELSE  
     103         CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry 
     104         CALL iom_get ( inum, jpdom_data, 'Bathy_level', zdta ) 
     105      ENDIF 
     106      CALL iom_close (inum) 
    146107 
    147108      ! land/sea mask over the global/zoom domain 
    148109 
    149110      imask(:,:)=1 
    150       WHERE ( zdta(jpizoom:(jpizoom+jpiglo-1),jpjzoom:(jpjglo+jpjzoom-1)) <= 0. ) imask = 0 
     111      WHERE ( zdta(:,:) <= 0. ) imask = 0 
    151112 
    152113      !  1. Dimension arrays for subdomains 
    … …  
    323284         DO jj = 1+jprecj, ilj-jprecj 
    324285            DO  ji = 1+jpreci, ili-jpreci 
    325                IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1 
     286               IF( imask(ji, jj) == 1) isurf = isurf+1 
    326287            END DO 
    327288         END DO 
    … …  
    336297      ! Control 
    337298      IF(icont+1 /= jpnij) THEN 
    338          IF(lwp) THEN  
    339             WRITE(numout,*) ' Eliminate land processors algorithm' 
    340             WRITE(numout,*) 
    341             WRITE(numout,*) ' jpni =',jpni,' jpnj =',jpnj 
    342             WRITE(numout,*) ' jpnij =',jpnij, '< jpni x jpnj'  
    343             WRITE(numout,*) 
    344             WRITE(numout,*) ' E R R O R ' 
    345             WRITE(numout,*) ' ***********, mpp_init2 finds jpnij=',icont+1 
    346             WRITE(numout,*) ' we stop' 
    347          ENDIF 
    348          STOP 'mpp_init2' 
    349       ENDIF 
    350  
     299         WRITE(ctmp1,*) ' jpni =',jpni,' jpnj =',jpnj 
     300         WRITE(ctmp2,*) ' jpnij =',jpnij, '< jpni x jpnj'  
     301         WRITE(ctmp3,*) ' ***********, mpp_init2 finds jpnij=',icont+1 
     302         CALL ctl_stop( ' Eliminate land processors algorithm', '', ctmp1, ctmp2, '', ctmp3 ) 
     303      ENDIF 
    351304 
    352305      ! 4. Subdomain print 
    … …  
    513466      ! Save processor layout in ascii file 
    514467      IF (lwp) THEN 
    515         OPEN(inum,FILE='layout.dat') 
    516         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo 
    517         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp' 
     468         inum = 11 ! how do we know that 11 is ok??? 
     469         OPEN(inum,FILE='layout.dat') 
     470         WRITE(inum,'(6i8)') jpnij,jpi,jpj,jpk,jpiglo,jpjglo 
     471         WRITE(inum,'(a)') 'NAREA nlci nlcj nldi nldj nlei nlej nimpp njmpp' 
    518472 
    519473        DO  jproc = 1, jpnij 
    … …  
    560514      ENDIF 
    561515 
    562       IF( nperio == 1 .AND.jpni /= 1 ) THEN 
    563          IF(lwp) WRITE(numout,cform_err) 
    564          IF(lwp) WRITE(numout,*) ' mpp_init2:  error on cyclicity' 
    565          nstop = nstop + 1 
    566       ENDIF 
     516      IF( nperio == 1 .AND.jpni /= 1 ) CALL ctl_stop( ' mpp_init2:  error on cyclicity' ) 
    567517 
    568518      ! Prepare mpp north fold 
    … …  
    588538         IF( ij == jpnj ) npolj = 5 
    589539      ENDIF 
    590        
     540 
    591541      ! Prepare NetCDF output file (if necessary) 
    592542      CALL mpp_init_ioipsl 
Note: See TracChangeset for help on using the changeset viewer.