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

Changeset 6717


Ignore:
Timestamp:
2016-06-17T12:00:46+02:00 (8 years ago)
Author:
gm
Message:

#1692 - branch SIMPLIF_2_usrdef: numerous improvement in the user defined interface

Location:
branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM
Files:
5 added
2 deleted
27 edited
3 moved

Legend:

Unmodified
Added
Removed

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/CONFIG/SHARED/namelist_ref

    r6667 r6717  
    7979   ln_use_jattr = .false.  !  use (T) the file attribute: open_ocean_jstart, if present 
    8080   !                       !  in netcdf input files, as the start j-row for reading 
    81 / 
    82 !----------------------------------------------------------------------- 
    83 &namzgr        !   vertical coordinate                                  (default: NO selection) 
    84 !----------------------------------------------------------------------- 
    85    ln_zco      = .false.   !  z-coordinate - full    steps 
    86    ln_zps      = .false.   !  z-coordinate - partial steps 
    87    ln_sco      = .false.   !  s- or hybrid z-s-coordinate 
    88    ln_isfcav   = .false.   !  ice shelf cavity 
    8981/ 
    9082!----------------------------------------------------------------------- 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/LIM_SRC_2/limdmp_2.F90

    r5836 r6717  
    144144       
    145145         resto_ice(:,:,:) = 0._wp 
    146          !      Re-calculate the North and South boundary restoring term 
    147          !      because those boundaries may change with the prescribed zoom area. 
    148146         ! 
    149147         irelax  = 16                     ! width of buffer zone with respect to close boundary 
    … …  
    156154         ! REM: if there is no ice in the model and in the data,  
    157155         !      no restoring even with non zero resto_ice 
    158          DO jj = mj0(jpjzoom - 1 + 1), mj1(jpjzoom -1 + irelax) 
    159             zreltim = zdmpmin + zfactor * ( mjg(jj) - jpjzoom + 1 ) 
     156         DO jj = mj0(1), mj1( irelax) 
     157            zreltim = zdmpmin + zfactor * mjg(jj) 
    160158            resto_ice(:,jj,:) = 1._wp / ( zreltim * 86400._wp ) 
    161159         END DO 
    162160 
    163161         ! North boundary restoring term 
    164          DO jj =  mj0(jpjzoom -1 + jpjglo - irelax), mj1(jpjzoom - 1 + jpjglo) 
    165             zreltim = zdmpmin + zfactor * (jpjglo - ( mjg(jj) - jpjzoom + 1 )) 
     162         DO jj =  mj0(jpjglo - irelax), mj1(jpjglo) 
     163            zreltim = zdmpmin + zfactor * (jpjglo - mjg(jj)) 
    166164            resto_ice(:,jj,:) = 1.e0 / ( zreltim * 86400 ) 
    167165         END DO 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/LIM_SRC_2/limsbc_2.F90

    r6140 r6717  
    449449      soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case 
    450450      sice_0(:,:) = sice 
    451       ! 
    452       IF( cp_cfg == "orca" ) THEN            ! decrease ocean & ice reference salinities in the Baltic sea  
    453          WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
    454             &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
    455             soce_0(:,:) = 4._wp 
    456             sice_0(:,:) = 2._wp 
    457          END WHERE 
    458       ENDIF 
     451      !                                      ! decrease ocean & ice reference salinities in the Baltic sea  
     452      WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
     453         &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
     454         soce_0(:,:) = 4._wp 
     455         sice_0(:,:) = 2._wp 
     456      END WHERE 
    459457      !                                      ! embedded sea ice 
    460458      IF( nn_ice_embd /= 0 ) THEN            ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass 
    … …  
    473471!!gm 
    474472         IF( .NOT.ln_linssh ) THEN 
    475  
    476             do jk = 1,jpkm1                     ! adjust initial vertical scale factors 
     473            DO jk = 1,jpkm1                     ! adjust initial vertical scale factors 
    477474               e3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    478475               e3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    479             end do 
     476            END DO 
    480477            e3t_a(:,:,:) = e3t_b(:,:,:) 
    481478            ! Reconstruction of all vertical scale factors at now and before time steps 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/LIM_SRC_3/limsbc.F90

    r6140 r6717  
    316316      soce_0(:,:) = soce                     ! constant SSS and ice salinity used in levitating sea-ice case 
    317317      sice_0(:,:) = sice 
    318       ! 
    319       IF( cp_cfg == "orca" ) THEN            ! decrease ocean & ice reference salinities in the Baltic sea  
    320          WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
    321             &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
    322             soce_0(:,:) = 4._wp 
    323             sice_0(:,:) = 2._wp 
    324          END WHERE 
    325       ENDIF 
     318      !                                      ! decrease ocean & ice reference salinities in the Baltic Sea area 
     319      WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.   & 
     320         &   54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp         )  
     321         soce_0(:,:) = 4._wp 
     322         sice_0(:,:) = 2._wp 
     323      END WHERE 
    326324      ! 
    327325      IF( .NOT. ln_rstart ) THEN 
    … …  
    331329            snwice_mass_b(:,:) = snwice_mass(:,:) 
    332330         ELSE 
    333             snwice_mass  (:,:) = 0.0_wp         ! no mass exchanges 
    334             snwice_mass_b(:,:) = 0.0_wp         ! no mass exchanges 
     331            snwice_mass  (:,:) = 0._wp          ! no mass exchanges 
     332            snwice_mass_b(:,:) = 0._wp          ! no mass exchanges 
    335333         ENDIF 
    336334         IF( nn_ice_embd == 2 ) THEN            ! full embedment (case 2) deplete the initial ssh below sea-ice area 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90

    r6403 r6717  
    55   !!===================================================================== 
    66   !! History :  3.0  !  2002-11  (C. Ethe)  F90: Free form and module 
     7   !!---------------------------------------------------------------------- 
     8#if defined key_lim3 
     9   !!---------------------------------------------------------------------- 
     10   !!   'key_lim3'                                      LIM3 sea-ice model 
    711   !!---------------------------------------------------------------------- 
    812   USE in_out_manager ! I/O manager 
    … …  
    175179   END FUNCTION thd_ice_alloc 
    176180    
     181#else 
     182   !!---------------------------------------------------------------------- 
     183   !!   Default option :         Empty module          NO LIM sea-ice model 
     184   !!---------------------------------------------------------------------- 
     185CONTAINS 
     186   SUBROUTINE thd_ice_alloc          ! Empty routine 
     187   END SUBROUTINE thd_ice_alloc 
     188#endif 
     189  
    177190   !!====================================================================== 
    178191END MODULE thd_ice 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r6596 r6717  
    3232! JC: change to allow for different vertical levels 
    3333!     jpk is already set 
    34 !     keep it jpk possibly different from jpkdta which  
     34!     keep it jpk possibly different from jpkglo which  
    3535!     hold parent grid vertical levels number (set earlier) 
    36 !      jpk     = jpkdta  
     36!      jpk     = jpkglo  
    3737      jpim1   = jpi-1  
    3838      jpjm1   = jpj-1  

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    r6140 r6717  
    100100 
    101101      DO ib_bdy = 1, nb_bdy 
    102          IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 
    103  
     102         IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 
     103            ! 
    104104            td => tides(ib_bdy) 
    105105            nblen => idx_bdy(ib_bdy)%nblen 
    … …  
    134134            ! JC: If FRS scheme is used, we assume that tidal is needed over the whole 
    135135            ! relaxation area       
    136             IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN 
    137                ilen0(:)=nblen(:) 
    138             ELSE 
    139                ilen0(:)=nblenrim(:) 
     136            IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN   ;   ilen0(:) = nblen   (:) 
     137            ELSE                                   ;   ilen0(:) = nblenrim(:) 
    140138            ENDIF 
    141139 
    … …  
    156154            td%v   (:,:,:) = 0._wp 
    157155 
    158             IF (ln_bdytide_2ddta) THEN 
     156            IF( ln_bdytide_2ddta ) THEN 
    159157               ! It is assumed that each data file contains all complex harmonic amplitudes 
    160                ! given on the data domain (ie global, jpidta x jpjdta) 
    161                ! 
    162                CALL wrk_alloc( jpi, jpj, zti, ztr ) 
     158               ! given on the global domain (ie global, jpiglo x jpjglo) 
     159               ! 
     160               CALL wrk_alloc( jpi,jpj,  zti, ztr ) 
    163161               ! 
    164162               ! SSH fields 
    165163               clfile = TRIM(filtide)//'_grid_T.nc' 
    166                CALL iom_open (clfile , inum )  
     164               CALL iom_open( clfile , inum )  
    167165               igrd = 1                       ! Everything is at T-points here 
    168166               DO itide = 1, nb_harmo 
    169                   CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) ) 
    170                   CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) )  
     167                  CALL iom_get( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) ) 
     168                  CALL iom_get( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) )  
    171169                  DO ib = 1, ilen0(igrd) 
    172170                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    … …  
    180178               ! U fields 
    181179               clfile = TRIM(filtide)//'_grid_U.nc' 
    182                CALL iom_open (clfile , inum )  
     180               CALL iom_open( clfile , inum )  
    183181               igrd = 2                       ! Everything is at U-points here 
    184182               DO itide = 1, nb_harmo 
    185                   CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_u1', ztr(:,:) ) 
    186                   CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_u2', zti(:,:) ) 
     183                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_u1', ztr(:,:) ) 
     184                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_u2', zti(:,:) ) 
    187185                  DO ib = 1, ilen0(igrd) 
    188186                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    … …  
    196194               ! V fields 
    197195               clfile = TRIM(filtide)//'_grid_V.nc' 
    198                CALL iom_open (clfile , inum )  
     196               CALL iom_open( clfile , inum )  
    199197               igrd = 3                       ! Everything is at V-points here 
    200198               DO itide = 1, nb_harmo 
    201                   CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_v1', ztr(:,:) ) 
    202                   CALL iom_get  ( inum, jpdom_data, TRIM(Wave(ntide(itide))%cname_tide)//'_v2', zti(:,:) ) 
     199                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_v1', ztr(:,:) ) 
     200                  CALL iom_get  ( inum, jpdom_autoglo, TRIM(Wave(ntide(itide))%cname_tide)//'_v2', zti(:,:) ) 
    203201                  DO ib = 1, ilen0(igrd) 
    204202                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    … …  
    210208               CALL iom_close( inum ) 
    211209               ! 
    212                CALL wrk_dealloc( jpi, jpj, ztr, zti )  
     210               CALL wrk_dealloc( jpi,jpj,  ztr, zti )  
    213211               ! 
    214212            ELSE             
    … …  
    219217               ! 
    220218               ! Set map structure 
    221                ibmap_ptr(1)%ptr => idx_bdy(ib_bdy)%nbmap(:,1) 
    222                ibmap_ptr(1)%ll_unstruc = ln_coords_file(ib_bdy) 
    223                ibmap_ptr(2)%ptr => idx_bdy(ib_bdy)%nbmap(:,2) 
    224                ibmap_ptr(2)%ll_unstruc = ln_coords_file(ib_bdy) 
    225                ibmap_ptr(3)%ptr => idx_bdy(ib_bdy)%nbmap(:,3) 
    226                ibmap_ptr(3)%ll_unstruc = ln_coords_file(ib_bdy) 
     219               ibmap_ptr(1)%ptr => idx_bdy(ib_bdy)%nbmap(:,1)   ;   ibmap_ptr(1)%ll_unstruc = ln_coords_file(ib_bdy) 
     220               ibmap_ptr(2)%ptr => idx_bdy(ib_bdy)%nbmap(:,2)   ;   ibmap_ptr(2)%ll_unstruc = ln_coords_file(ib_bdy) 
     221               ibmap_ptr(3)%ptr => idx_bdy(ib_bdy)%nbmap(:,3)   ;   ibmap_ptr(3)%ll_unstruc = ln_coords_file(ib_bdy) 
    227222 
    228223               ! Open files and read in tidal forcing data 
    … …  
    258253               ! 
    259254               DEALLOCATE( dta_read ) 
     255               ! 
    260256            ENDIF ! ln_bdytide_2ddta=.true. 
    261257            ! 
    … …  
    275271            dta_bdy_s(ib_bdy)%v2d(:) = 0._wp 
    276272            ! 
    277          ENDIF ! nn_dyn2d_dta(ib_bdy) .ge. 2 
     273         ENDIF ! nn_dyn2d_dta(ib_bdy) >= 2 
    278274         ! 
    279275      END DO ! loop on ib_bdy 
    … …  
    376372   END SUBROUTINE bdytide_update 
    377373 
     374 
    378375   SUBROUTINE bdy_dta_tides( kt, kit, time_offset ) 
    379376      !!---------------------------------------------------------------------- 
    … …  
    422419 
    423420      DO ib_bdy = 1,nb_bdy 
    424  
    425          IF ( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 
    426  
     421         ! 
     422         IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 
     423            ! 
    427424            nblen(1:jpbgrd) = idx_bdy(ib_bdy)%nblen(1:jpbgrd) 
    428425            nblenrim(1:jpbgrd) = idx_bdy(ib_bdy)%nblenrim(1:jpbgrd) 
    429  
    430             IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN 
    431                ilen0(:)=nblen(:) 
    432             ELSE 
    433                ilen0(:)=nblenrim(:) 
     426            ! 
     427            IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN   ;   ilen0(:) = nblen   (:) 
     428            ELSE                                   ;   ilen0(:) = nblenrim(:) 
    434429            ENDIF      
    435  
     430            ! 
    436431            ! We refresh nodal factors every day below 
    437432            ! This should be done somewhere else 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90

    r6596 r6717  
    392392        ENDIF                
    393393 
    394         IF( iptglo .NE. 0 )THEN 
     394        IF( iptglo /= 0 )THEN 
    395395              
    396396           !read points'coordinates and directions  
    … …  
    399399           directemp(:) = 0                  !value of directions of each points 
    400400           DO jpt=1,iptglo 
    401               READ(numdct_in)i1,i2 
     401              READ(numdct_in) i1, i2 
    402402              coordtemp(jpt)%I = i1  
    403403              coordtemp(jpt)%J = i2 
    404404           ENDDO 
    405            READ(numdct_in)directemp(1:iptglo) 
     405           READ(numdct_in) directemp(1:iptglo) 
    406406     
    407407           !debug 
    … …  
    416416           !Now each proc selects only points that are in its domain: 
    417417           !-------------------------------------------------------- 
    418            iptloc = 0                    !initialize number of points selected 
    419            DO jpt=1,iptglo               !loop on listpoint read in the file 
    420                      
     418           iptloc = 0                    ! initialize number of points selected 
     419           DO jpt = 1, iptglo            ! loop on listpoint read in the file 
     420              !       
    421421              iiglo=coordtemp(jpt)%I          ! global coordinates of the point 
    422422              ijglo=coordtemp(jpt)%J          !  "  
    423423 
    424               IF( iiglo==jpidta .AND. nimpp==1 ) iiglo = 2 
     424              IF( iiglo==jpiglo .AND. nimpp==1 )   iiglo = 2         !!gm BUG: Hard coded periodicity ! 
    425425 
    426426              iiloc=iiglo-nimpp+1   ! local coordinates of the point 
    … …  
    428428 
    429429              !verify if the point is on the local domain:(1,nlei)*(1,nlej) 
    430               IF( iiloc .GE. 1 .AND. iiloc .LE. nlei .AND. & 
    431                   ijloc .GE. 1 .AND. ijloc .LE. nlej       )THEN 
     430              IF( iiloc >= 1 .AND. iiloc <= nlei .AND. & 
     431                  ijloc >= 1 .AND. ijloc <= nlej       )THEN 
    432432                 iptloc = iptloc + 1                                                 ! count local points 
    433433                 secs(jsec)%listPoint(iptloc) = POINT_SECTION(mi0(iiglo),mj0(ijglo)) ! store local coordinates 
    434434                 secs(jsec)%direction(iptloc) = directemp(jpt)                       ! store local direction 
    435435              ENDIF 
    436  
    437            ENDDO 
     436              ! 
     437           END DO 
    438438      
    439439           secs(jsec)%nb_point=iptloc !store number of section's points 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90

    r6387 r6717  
    666666         CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm"              , "m"      ,   & ! hd28 
    667667            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    668          CALL histdef( nid_T, "sohtc300", "Heat content 300 m"                 , "W"      ,   & ! htc3 
     668         CALL histdef( nid_T, "sohtc300", "Heat content 300 m"                 , "J/m2"   ,   & ! htc3 
    669669            &          jpi, jpj, nh_T, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) 
    670670#endif 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r6667 r6717  
    166166 
    167167   !!---------------------------------------------------------------------- 
    168    !! masks, bathymetry 
     168   !! masks, top and bottom ocean point position 
    169169   !! --------------------------------------------------------------------- 
    170 !!gm   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbathy             !: number of ocean level (=0, 1, ... , jpk-1) 
    171170   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mbkt, mbku, mbkv   !: bottom last wet T-, U- and V-level 
    172 !!gm   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bathy              !: ocean depth (meters) 
    173171   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_i            !: interior domain T-point mask 
    174172   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_h            !: internal domain T-point mask (Figure 8.5 NEMO book) 
    … …  
    178176   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   risfdep                 !: Iceshelf draft                    (ISF) 
    179177 
    180    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask, ssfmask    !: surface mask at T-,U-, V- and F-pts 
     178   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask             !: surface mask at T-,U-, V- and F-pts 
    181179   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts 
    182180   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts 
    … …  
    258256         &      njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,     & 
    259257         &                                      nleit(jpnij) , nlejt(jpnij) ,     & 
    260          &      mi0(jpidta)   , mi1 (jpidta),  mj0(jpjdta)   , mj1 (jpjdta) ,     & 
     258         &      mi0(jpiglo)   , mi1 (jpiglo),  mj0(jpjglo)   , mj1 (jpjglo) ,     & 
    261259         &      tpol(jpiglo)  , fpol(jpiglo)                                , STAT=ierr(2) ) 
    262260         ! 
    … …  
    295293         &      e3t_1d  (jpk) , e3w_1d  (jpk) , e3tp (jpi,jpj), e3wp(jpi,jpj) , STAT=ierr(7) ) 
    296294         ! 
    297       ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                                       &  
    298          &      ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) , ssfmask(jpi,jpj) , & 
     295      ALLOCATE( tmask_i(jpi,jpj) , tmask_h(jpi,jpj) ,                        &  
     296         &      ssmask (jpi,jpj) , ssumask(jpi,jpj) , ssvmask(jpi,jpj) ,     & 
    299297         &      mbkt   (jpi,jpj) , mbku   (jpi,jpj) , mbkv   (jpi,jpj) , STAT=ierr(9) ) 
    300298         ! 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r6667 r6717  
    2020   !!   dom_nam       : read and contral domain namelists 
    2121   !!   dom_ctl       : control print for the ocean domain 
    22    !!   cfg_wri       : create the "domain_cfg.nc" file containing all required configuration information    
     22   !!   cfg_write     : create the "domain_cfg.nc" file containing all required configuration information    
    2323   !!---------------------------------------------------------------------- 
    24    USE oce             ! ocean variables 
    25    USE dom_oce         ! domain: ocean 
    26    USE sbc_oce         ! surface boundary condition: ocean 
    27    USE phycst          ! physical constants 
    28    USE closea          ! closed seas 
    29    USE domhgr          ! domain: set the horizontal mesh 
    30    USE domzgr          ! domain: set the vertical mesh 
    31    USE dommsk          ! domain: set the mask system 
    32    USE domwri          ! domain: write the meshmask file 
    33    USE domvvl          ! variable volume 
    34    USE c1d             ! 1D vertical configuration 
    35    USE dyncor_c1d      ! Coriolis term (c1d case)         (cor_c1d routine) 
     24   USE oce            ! ocean variables 
     25   USE dom_oce        ! domain: ocean 
     26   USE sbc_oce        ! surface boundary condition: ocean 
     27   USE phycst         ! physical constants 
     28   USE usrdef_closea  ! closed seas 
     29   USE domhgr         ! domain: set the horizontal mesh 
     30   USE domzgr         ! domain: set the vertical mesh 
     31   USE dommsk         ! domain: set the mask system 
     32   USE domwri         ! domain: write the meshmask file 
     33   USE domvvl         ! variable volume 
     34   USE c1d            ! 1D vertical configuration 
     35   USE dyncor_c1d     ! Coriolis term (c1d case)         (cor_c1d routine) 
    3636   ! 
    37    USE in_out_manager  ! I/O manager 
    38    USE iom             ! I/O library 
    39    USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    40    USE lib_mpp         ! distributed memory computing library 
    41    USE wrk_nemo        ! Memory Allocation 
    42    USE timing          ! Timing 
     37   USE in_out_manager ! I/O manager 
     38   USE iom            ! I/O library 
     39   USE lbclnk         ! ocean lateral boundary condition (or mpp link) 
     40   USE lib_mpp        ! distributed memory computing library 
     41   USE wrk_nemo       ! Memory Allocation 
     42   USE timing         ! Timing 
    4343 
    4444   IMPLICIT NONE 
    … …  
    8686         WRITE(numout,*)     '      dimension of model' 
    8787         WRITE(numout,*)     '             Local domain      Global domain       Data domain ' 
    88          WRITE(numout,cform) '        ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo, '   jpidta  : ', jpidta 
    89          WRITE(numout,cform) '        ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo, '   jpjdta  : ', jpjdta 
    90          WRITE(numout,cform) '        ','   jpk     : ', jpk, '   jpkglo  : ', jpkglo, '   jpkdta  : ', jpkdta 
     88         WRITE(numout,cform) '        ','   jpi     : ', jpi, '   jpiglo  : ', jpiglo 
     89         WRITE(numout,cform) '        ','   jpj     : ', jpj, '   jpjglo  : ', jpjglo 
     90         WRITE(numout,cform) '        ','   jpk     : ', jpk, '   jpkglo  : ', jpkglo 
    9191         WRITE(numout,cform) '       ' ,'   jpij    : ', jpij 
    9292         WRITE(numout,*)     '      mpp local domain info (mpp)' 
    … …  
    100100      !       
    101101      CALL dom_nam                     ! read namelist ( namrun, namdom ) 
    102       CALL dom_clo                     ! Closed seas and lake 
     102      CALL dom_clo( cp_cfg, jp_cfg )   ! Closed seas and lake 
    103103      CALL dom_hgr                     ! Horizontal mesh 
    104104      CALL dom_zgr( ik_top, ik_bot )   ! Vertical mesh and bathymetry 
     105      IF( nn_closea == 0 )   CALL clo_bat( ik_top, ik_bot )    !==  remove closed seas or lakes  ==! 
    105106      CALL dom_msk( ik_top, ik_bot )   ! Masks 
    106107      ! 
    … …  
    171172      ENDIF 
    172173      ! 
    173       IF( ln_write_cfg )   CALL cfg_wri           ! create the configuration file 
     174      IF( ln_write_cfg )   CALL cfg_write         ! create the configuration file 
    174175      ! 
    175176      IF( nn_timing == 1 )   CALL timing_stop('dom_init') 
    … …  
    405406 
    406407 
    407    SUBROUTINE cfg_wri 
    408       !!---------------------------------------------------------------------- 
    409       !!                  ***  ROUTINE cfg_wri  *** 
     408   SUBROUTINE cfg_write 
     409      !!---------------------------------------------------------------------- 
     410      !!                  ***  ROUTINE cfg_write  *** 
    410411      !!                    
    411       !! ** Purpose :   Create the NetCDF file(s) which contain(s) all the 
    412       !!      ocean domain informations (mesh and mask arrays). This (these) 
    413       !!      file(s) is (are) used for visualisation (SAXO software) and 
    414       !!      diagnostic computation. 
     412      !! ** Purpose :   Create the "domain_cfg" file, a NetCDF file which  
     413      !!              contains all the ocean domain informations required to  
     414      !!              define an ocean configuration. 
    415415      !! 
    416       !! ** Method  :   Write in a file all the arrays generated in routines 
    417       !!      domhgr, domzgr, and dommsk. Note: the file contain depends on 
    418       !!      the vertical coord. used (z-coord, partial steps, s-coord) 
    419       !!            MOD(nn_msh, 3) = 1  :   'mesh_mask.nc' file 
    420       !!                         = 2  :   'mesh.nc' and mask.nc' files 
    421       !!                         = 0  :   'mesh_hgr.nc', 'mesh_zgr.nc' and 
    422       !!                                  'mask.nc' files 
    423       !!      For huge size domain, use option 2 or 3 depending on your  
    424       !!      vertical coordinate. 
     416      !! ** Method  :   Write in a file all the arrays required to set up an 
     417      !!              ocean configuration. 
    425418      !! 
    426       !!      if     nn_msh <= 3: write full 3D arrays for e3[tuvw] and gdep[tuvw] 
    427       !!      if 3 < nn_msh <= 6: write full 3D arrays for e3[tuvw] and 2D arrays  
    428       !!                        corresponding to the depth of the bottom t- and w-points 
    429       !!      if 6 < nn_msh <= 9: write 2D arrays corresponding to the depth and the 
    430       !!                        thickness (e3[tw]_ps) of the bottom points  
    431       !! 
    432       !! ** output file :   meshmask.nc  : domain size, horizontal grid-point position, 
    433       !!                                   masks, depth and vertical scale factors 
     419      !! ** output file :   domain_cfg.nc : domain size, characteristics, horizontal mesh, 
     420      !!                              Coriolis parameter, depth and vertical scale factors 
    434421      !!---------------------------------------------------------------------- 
    435422      INTEGER           ::   ji, jj, jk   ! dummy loop indices 
    … …  
    441428      ! 
    442429      IF(lwp) WRITE(numout,*) 
    443       IF(lwp) WRITE(numout,*) 'cfg_wri : create the "domain_cfg.nc" file containing all required configuration information' 
    444       IF(lwp) WRITE(numout,*) '~~~~~~~' 
     430      IF(lwp) WRITE(numout,*) 'cfg_write : create the "domain_cfg.nc" file containing all required configuration information' 
     431      IF(lwp) WRITE(numout,*) '~~~~~~~~~' 
    445432      ! 
    446433      !                       ! ============================= ! 
    … …  
    532519      CALL iom_close( inum ) 
    533520      ! 
    534    END SUBROUTINE cfg_wri 
     521   END SUBROUTINE cfg_write 
    535522 
    536523   !!====================================================================== 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/domhgr.F90

    r6667 r6717  
    2626   USE par_oce        ! ocean space and time domain 
    2727   USE phycst         ! physical constants 
    28    USE usrdef         ! User defined routine 
     28   USE usrdef_hgr     ! User defined routine 
    2929   ! 
    3030   USE in_out_manager ! I/O manager 
    … …  
    121121      ELSE 
    122122         IF( ln_read_cfg ) THEN 
    123             IF(lwp) WRITE(numout,*) '          Coriolis parameter have been read in "mesh_mask" file' 
     123            IF(lwp) WRITE(numout,*) '          Coriolis parameter have been read in "domain_cfg" file' 
    124124         ELSE 
    125125            IF(lwp) WRITE(numout,*) '          Coriolis parameter have been set in usr_def_hgr routine' 
    … …  
    210210      IF(  iom_varid( inum, 'ff_f', ldstop = .FALSE. ) > 0  .AND.  & 
    211211         & iom_varid( inum, 'ff_t', ldstop = .FALSE. ) > 0    ) THEN 
    212          IF(lwp) WRITE(numout,*) '           Coriolis factor at f- and t-points read in mesh_mask file' 
     212         IF(lwp) WRITE(numout,*) '           Coriolis factor at f- and t-points read in domain_cfg file' 
    213213         CALL iom_get( inum, jpdom_data, 'ff_f'  , ff_f  , lrowattr=ln_use_jattr ) 
    214214         CALL iom_get( inum, jpdom_data, 'ff_t'  , ff_t  , lrowattr=ln_use_jattr ) 
    … …  
    219219      ! 
    220220      IF( iom_varid( inum, 'e1e2u', ldstop = .FALSE. ) > 0 ) THEN 
    221          IF(lwp) WRITE(numout,*) '           e1e2u & e1e2v read in mesh_mask file' 
     221         IF(lwp) WRITE(numout,*) '           e1e2u & e1e2v read in domain_cfg file' 
    222222         CALL iom_get( inum, jpdom_data, 'e1e2u'  , e1e2u  , lrowattr=ln_use_jattr ) 
    223223         CALL iom_get( inum, jpdom_data, 'e1e2v'  , e1e2v  , lrowattr=ln_use_jattr ) 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r6667 r6717  
    1717   !!            3.2  ! 2009-07  (R. Benshila) Suppression of rigid-lid option 
    1818   !!            3.6  ! 2015-05  (P. Mathiot) ISF: add wmask,wumask and wvmask 
    19    !!---------------------------------------------------------------------- 
    20  
    21    !!---------------------------------------------------------------------- 
    22    !!   dom_msk        : compute land/ocean mask 
    23    !!---------------------------------------------------------------------- 
    24    USE oce             ! ocean dynamics and tracers 
    25    USE dom_oce         ! ocean space and time domain 
     19   !!            4.0  ! 2016-06  (G. Madec, S. Flavoni)  domain configuration / user defined interface 
     20   !!---------------------------------------------------------------------- 
     21 
     22   !!---------------------------------------------------------------------- 
     23   !!   dom_msk       : compute land/ocean mask 
     24   !!---------------------------------------------------------------------- 
     25   USE oce            ! ocean dynamics and tracers 
     26   USE dom_oce        ! ocean space and time domain 
     27   USE usrdef_fmask   ! user defined fmask 
    2628   ! 
    27    USE in_out_manager  ! I/O manager 
    28    USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    29    USE lib_mpp         ! 
    30    USE wrk_nemo        ! Memory allocation 
    31    USE timing          ! Timing 
     29   USE in_out_manager ! I/O manager 
     30   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     31   USE lib_mpp        ! Massively Parallel Processing library 
     32   USE wrk_nemo       ! Memory allocation 
     33   USE timing         ! Timing 
    3234 
    3335   IMPLICIT NONE 
    … …  
    7375      !!                as MPP halos. 
    7476      !!      tmask_h : halo mask at t-point, i.e. excluding duplicated rows/lines 
    75       !!                due to cyclic or North Fold boundaries as well 
    76       !!                as MPP halos. 
    77       !! 
    78       !!      In case of open boundaries (lk_bdy=T): 
    79       !!        - tmask is set to 1 on the points to be computed by the open 
    80       !!          boundaries routines. 
     77      !!                due to cyclic or North Fold boundaries as well as MPP halos. 
    8178      !! 
    8279      !! ** Action :   tmask, umask, vmask, wmask, wumask, wvmask : land/ocean mask  
    … …  
    9087      INTEGER, DIMENSION(:,:), INTENT(in) ::   k_top, k_bot   ! first and last ocean level 
    9188      ! 
    92       INTEGER  ::   ji, jj, jk               ! dummy loop indices 
    93       INTEGER  ::   iif, iil, ii0, ii1, ii   ! local integers 
    94       INTEGER  ::   ijf, ijl, ij0, ij1       !   -       - 
    95       INTEGER  ::   iktop, ikbot             !   -       - 
     89      INTEGER  ::   ji, jj, jk     ! dummy loop indices 
     90      INTEGER  ::   iif, iil       ! local integers 
     91      INTEGER  ::   ijf, ijl       !   -       - 
     92      INTEGER  ::   iktop, ikbot   !   -       - 
    9693      INTEGER  ::   ios 
    97       INTEGER  ::   isrow                    ! index for ORCA1 starting row 
    98       REAL(wp), POINTER, DIMENSION(:,:) ::  zwf 
     94      REAL(wp), POINTER, DIMENSION(:,:) ::   zwf   ! 2D workspace 
    9995      !! 
    10096      NAMELIST/namlbc/ rn_shlat, ln_vorlat 
    … …  
    144140      END DO   
    145141 
    146       ! 2D ocean mask (=1 if at least one level of the water column is ocean, =0 otherwise) 
    147       WHERE( k_bot(:,:) > 0 )   ;   ssmask(:,:) = 1._wp 
    148       ELSEWHERE                 ;   ssmask(:,:) = 0._wp 
    149       END WHERE 
    150142       
    151        
     143      !  Ocean/land mask at u-, v-, and f-points   (computed from tmask) 
     144      ! ---------------------------------------- 
     145      ! NB: at this point, fmask is designed for free slip lateral boundary condition 
     146      DO jk = 1, jpk 
     147         DO jj = 1, jpjm1 
     148            DO ji = 1, fs_jpim1   ! vector loop 
     149               umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk) 
     150               vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk) 
     151            END DO 
     152            DO ji = 1, jpim1      ! NO vector opt. 
     153               fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   & 
     154                  &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk) 
     155            END DO 
     156         END DO 
     157      END DO 
     158      CALL lbc_lnk( umask  , 'U', 1._wp )      ! Lateral boundary conditions 
     159      CALL lbc_lnk( vmask  , 'V', 1._wp ) 
     160      CALL lbc_lnk( fmask  , 'F', 1._wp ) 
     161 
     162  
     163      ! Ocean/land mask at wu-, wv- and w points    (computed from tmask) 
     164      !----------------------------------------- 
     165      wmask (:,:,1) = tmask(:,:,1)     ! surface 
     166      wumask(:,:,1) = umask(:,:,1) 
     167      wvmask(:,:,1) = vmask(:,:,1) 
     168      DO jk = 2, jpk                   ! interior values 
     169         wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1) 
     170         wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)    
     171         wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1) 
     172      END DO 
     173 
     174 
     175      ! Ocean/land column mask at t-, u-, and v-points   (i.e. at least 1 wet cell in the vertical) 
     176      ! ---------------------------------------------- 
     177      ssmask (:,:) = MAXVAL( tmask(:,:,:), DIM=3 ) 
     178      ssumask(:,:) = MAXVAL( umask(:,:,:), DIM=3 ) 
     179      ssvmask(:,:) = MAXVAL( vmask(:,:,:), DIM=3 ) 
     180 
     181 
    152182      ! Interior domain mask  (used for global sum) 
    153183      ! -------------------- 
    … …  
    185215 
    186216 
    187       !  Ocean/land mask at u-, v-, and z-points (computed from tmask) 
    188       ! ---------------------------------------- 
    189       DO jk = 1, jpk 
    190          DO jj = 1, jpjm1 
    191             DO ji = 1, fs_jpim1   ! vector loop 
    192                umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk) 
    193                vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk) 
    194             END DO 
    195             DO ji = 1, jpim1      ! NO vector opt. 
    196                fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   & 
    197                   &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk) 
     217      ! Lateral boundary conditions on velocity (modify fmask) 
     218      ! ---------------------------------------   
     219      IF( rn_shlat /= 0 ) THEN      ! Not free-slip lateral boundary condition 
     220         ! 
     221         CALL wrk_alloc( jpi,jpj,   zwf ) 
     222         ! 
     223         DO jk = 1, jpk 
     224            zwf(:,:) = fmask(:,:,jk)          
     225            DO jj = 2, jpjm1 
     226               DO ji = fs_2, fs_jpim1   ! vector opt. 
     227                  IF( fmask(ji,jj,jk) == 0._wp ) THEN 
     228                     fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   & 
     229                        &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  ) 
     230                  ENDIF 
     231               END DO 
     232            END DO 
     233            DO jj = 2, jpjm1 
     234               IF( fmask(1,jj,jk) == 0._wp ) THEN 
     235                  fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 
     236               ENDIF 
     237               IF( fmask(jpi,jj,jk) == 0._wp ) THEN 
     238                  fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
     239               ENDIF 
     240            END DO          
     241            DO ji = 2, jpim1 
     242               IF( fmask(ji,1,jk) == 0._wp ) THEN 
     243                  fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 
     244               ENDIF 
     245               IF( fmask(ji,jpj,jk) == 0._wp ) THEN 
     246                  fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 
     247               ENDIF 
    198248            END DO 
    199249         END DO 
    200       END DO 
    201       ! (ISF) MIN(1,SUM(umask)) is here to check if you have effectively at least 1 wet cell at u point 
    202       DO jj = 1, jpjm1 
    203          DO ji = 1, fs_jpim1   ! vector loop 
    204 !!gm  simpler : 
    205 !            ssumask(ji,jj)  = MIN(  1._wp , SUM( umask(ji,jj,:) )  ) 
    206 !            ssvmask(ji,jj)  = MIN(  1._wp , SUM( vmask(ji,jj,:) )  ) 
    207 !!gm 
    208 !!gm  faster : 
    209 !         ssumask(ji,jj) = ssmask(ji,jj) * tmask(ji+1,jj  ) 
    210 !         ssvmask(ji,jj) = ssmask(ji,jj) * tmask(ji  ,jj+1) 
    211 !!gm 
    212             ssumask(ji,jj)  = ssmask(ji,jj) * ssmask(ji+1,jj  )  * MIN(1._wp,SUM(umask(ji,jj,:))) 
    213             ssvmask(ji,jj)  = ssmask(ji,jj) * ssmask(ji  ,jj+1)  * MIN(1._wp,SUM(vmask(ji,jj,:))) 
    214 !!end 
    215          END DO 
    216          DO ji = 1, jpim1      ! NO vector opt. 
    217 !!gm faster 
    218 !            ssfmask(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   & 
    219 !               &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) 
    220 !!gm  
    221             ssfmask(ji,jj) =  ssmask(ji,jj  ) * ssmask(ji+1,jj  )   & 
    222                &            * ssmask(ji,jj+1) * ssmask(ji+1,jj+1) * MIN(1._wp,SUM(fmask(ji,jj,:))) 
    223 !!gm 
    224          END DO 
    225       END DO 
    226       CALL lbc_lnk( umask  , 'U', 1._wp )      ! Lateral boundary conditions 
    227       CALL lbc_lnk( vmask  , 'V', 1._wp ) 
    228 !      CALL lbc_lnk( fmask  , 'F', 1._wp )         ! applied after the specification of lateral b.c. 
    229       CALL lbc_lnk( ssumask, 'U', 1._wp ) 
    230       CALL lbc_lnk( ssvmask, 'V', 1._wp ) 
    231       CALL lbc_lnk( ssfmask, 'F', 1._wp ) 
    232  
    233  
    234       ! Ocean/land mask at wu-, wv- and w points  
    235       !---------------------------------------------- 
    236       wmask (:,:,1) = tmask(:,:,1)     ! surface 
    237       wumask(:,:,1) = umask(:,:,1) 
    238       wvmask(:,:,1) = vmask(:,:,1) 
    239       DO jk = 2, jpk                   ! interior values 
    240          wmask (:,:,jk) = tmask(:,:,jk) * tmask(:,:,jk-1) 
    241          wumask(:,:,jk) = umask(:,:,jk) * umask(:,:,jk-1)    
    242          wvmask(:,:,jk) = vmask(:,:,jk) * vmask(:,:,jk-1) 
    243       END DO 
    244  
    245  
    246       ! Lateral boundary conditions on velocity (modify fmask) 
    247       ! ---------------------------------------      
    248       CALL wrk_alloc( jpi,jpj,   zwf  ) 
    249       ! 
    250       DO jk = 1, jpk 
    251          zwf(:,:) = fmask(:,:,jk)          
    252          DO jj = 2, jpjm1 
    253             DO ji = fs_2, fs_jpim1   ! vector opt. 
    254                IF( fmask(ji,jj,jk) == 0._wp ) THEN 
    255                   fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   & 
    256                      &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  ) 
    257                ENDIF 
    258             END DO 
    259          END DO 
    260          DO jj = 2, jpjm1 
    261             IF( fmask(1,jj,jk) == 0._wp ) THEN 
    262                fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 
    263             ENDIF 
    264             IF( fmask(jpi,jj,jk) == 0._wp ) THEN 
    265                fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
    266             ENDIF 
    267          END DO          
    268          DO ji = 2, jpim1 
    269             IF( fmask(ji,1,jk) == 0._wp ) THEN 
    270                fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 
    271             ENDIF 
    272             IF( fmask(ji,jpj,jk) == 0._wp ) THEN 
    273                fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 
    274             ENDIF 
    275          END DO 
    276       END DO 
    277       ! 
    278       CALL wrk_dealloc( jpi,jpj,   zwf  ) 
    279       ! 
    280       IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA_R2 configuration 
    281          !                                                 ! Increased lateral friction near of some straits 
    282          !                                ! Gibraltar strait  : partial slip (fmask=0.5) 
    283          ij0 = 101   ;   ij1 = 101 
    284          ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp 
    285          ij0 = 102   ;   ij1 = 102 
    286          ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp 
    287          ! 
    288          !                                ! Bab el Mandeb : partial slip (fmask=1) 
    289          ij0 =  87   ;   ij1 =  88 
    290          ii0 = 160   ;   ii1 = 160   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp 
    291          ij0 =  88   ;   ij1 =  88 
    292          ii0 = 159   ;   ii1 = 159   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp 
    293          ! 
    294          !                                ! Danish straits  : strong slip (fmask > 2) 
    295 ! We keep this as an example but it is instable in this case  
    296 !         ij0 = 115   ;   ij1 = 115 
    297 !         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp 
    298 !         ij0 = 116   ;   ij1 = 116 
    299 !         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp 
    300          ! 
    301       ENDIF 
    302       ! 
    303       IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN   ! ORCA R1 configuration 
    304          !                                                 ! Increased lateral friction near of some straits 
    305          ! This dirty section will be suppressed by simplification process: 
    306          ! all this will come back in input files 
    307          ! Currently these hard-wired indices relate to configuration with 
    308          ! extend grid (jpjglo=332) 
    309          ! 
    310          isrow = 332 - jpjglo 
    311          ! 
    312          IF(lwp) WRITE(numout,*) 
    313          IF(lwp) WRITE(numout,*) '   orca_r1: increase friction near the following straits : ' 
    314          IF(lwp) WRITE(numout,*) '      Gibraltar ' 
    315          ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait  
    316          ij0 = 241 - isrow   ;   ij1 = 241 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    317  
    318          IF(lwp) WRITE(numout,*) '      Bhosporus ' 
    319          ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait  
    320          ij0 = 248 - isrow   ;   ij1 = 248 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    321  
    322          IF(lwp) WRITE(numout,*) '      Makassar (Top) ' 
    323          ii0 =  48           ;   ii1 =  48        ! Makassar Strait (Top)  
    324          ij0 = 189 - isrow   ;   ij1 = 190 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
    325  
    326          IF(lwp) WRITE(numout,*) '      Lombok ' 
    327          ii0 =  44           ;   ii1 =  44        ! Lombok Strait  
    328          ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    329  
    330          IF(lwp) WRITE(numout,*) '      Ombai ' 
    331          ii0 =  53           ;   ii1 =  53        ! Ombai Strait  
    332          ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    333  
    334          IF(lwp) WRITE(numout,*) '      Timor Passage ' 
    335          ii0 =  56           ;   ii1 =  56        ! Timor Passage  
    336          ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    337  
    338          IF(lwp) WRITE(numout,*) '      West Halmahera ' 
    339          ii0 =  58           ;   ii1 =  58        ! West Halmahera Strait  
    340          ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
    341  
    342          IF(lwp) WRITE(numout,*) '      East Halmahera ' 
    343          ii0 =  55           ;   ii1 =  55        ! East Halmahera Strait  
    344          ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   fmask( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
    345          ! 
    346       ENDIF 
    347       ! 
    348       CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask 
    349       ! 
    350       ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) 
     250         ! 
     251         CALL wrk_dealloc( jpi,jpj,   zwf ) 
     252         ! 
     253         CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask 
     254         ! 
     255         ! CAUTION : The fmask may be further modified in dyn_vor_init ( dynvor.F90 ) depending on ln_vorlat 
     256         ! 
     257      ENDIF 
     258       
     259      ! User defined alteration of fmask (use to reduce ocean transport in specified straits) 
     260      ! --------------------------------  
     261      ! 
     262      CALL usr_def_fmask( cp_cfg, jp_cfg, fmask ) 
     263      ! 
    351264      ! 
    352265      IF( nn_timing == 1 )  CALL timing_stop('dom_msk') 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/domwri.F90

    r6667 r6717  
    88   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90 and several file 
    99   !!            3.0  ! 2008-01  (S. Masson)  add dom_uniq  
     10   !!            4.0  ! 2016-01  (G. Madec)  simplified mesh_mask.nc file 
    1011   !!---------------------------------------------------------------------- 
    1112 
    … …  
    2728 
    2829   PUBLIC   dom_wri              ! routine called by inidom.F90 
    29    PUBLIC   dom_wri_coordinate   ! routine called by domhgr.F90 
    3030   PUBLIC   dom_stiff            ! routine called by inidom.F90 
    3131 
    … …  
    3333#  include "vectopt_loop_substitute.h90" 
    3434   !!---------------------------------------------------------------------- 
    35    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     35   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    3636   !! $Id$  
    3737   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3838   !!---------------------------------------------------------------------- 
    3939CONTAINS 
    40  
    41    SUBROUTINE dom_wri_coordinate 
    42       !!---------------------------------------------------------------------- 
    43       !!                  ***  ROUTINE dom_wri_coordinate  *** 
    44       !!                    
    45       !! ** Purpose :   Create the NetCDF file which contains all the 
    46       !!              standard coordinate information plus the surface, 
    47       !!              e1e2u and e1e2v. By doing so, those surface will 
    48       !!              not be changed by the reduction of e1u or e2v scale  
    49       !!              factors in some straits.  
    50       !!                 NB: call just after the read of standard coordinate 
    51       !!              and the reduction of scale factors in some straits 
    52       !! 
    53       !! ** output file :   coordinate_e1e2u_v.nc 
    54       !!---------------------------------------------------------------------- 
    55       INTEGER           ::   inum0    ! temprary units for 'coordinate_e1e2u_v.nc' file 
    56       CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations) 
    57       !                                   !  workspaces 
    58       REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw  
    59       REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv 
    60       !!---------------------------------------------------------------------- 
    61       ! 
    62       IF( nn_timing == 1 )  CALL timing_start('dom_wri_coordinate') 
    63       ! 
    64       IF(lwp) WRITE(numout,*) 
    65       IF(lwp) WRITE(numout,*) 'dom_wri_coordinate : create NetCDF coordinate file' 
    66       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~~~' 
    67        
    68       clnam0 = 'coordinate_e1e2u_v'  ! filename (mesh and mask informations) 
    69        
    70       !  create 'coordinate_e1e2u_v.nc' file 
    71       ! ============================ 
    72       ! 
    73       CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib ) 
    74       ! 
    75       !                                                         ! horizontal mesh (inum3) 
    76       CALL iom_rstput( 0, 0, inum0, 'glamt', glamt, ktype = jp_r8 )     !    ! latitude 
    77       CALL iom_rstput( 0, 0, inum0, 'glamu', glamu, ktype = jp_r8 ) 
    78       CALL iom_rstput( 0, 0, inum0, 'glamv', glamv, ktype = jp_r8 ) 
    79       CALL iom_rstput( 0, 0, inum0, 'glamf', glamf, ktype = jp_r8 ) 
    80        
    81       CALL iom_rstput( 0, 0, inum0, 'gphit', gphit, ktype = jp_r8 )     !    ! longitude 
    82       CALL iom_rstput( 0, 0, inum0, 'gphiu', gphiu, ktype = jp_r8 ) 
    83       CALL iom_rstput( 0, 0, inum0, 'gphiv', gphiv, ktype = jp_r8 ) 
    84       CALL iom_rstput( 0, 0, inum0, 'gphif', gphif, ktype = jp_r8 ) 
    85        
    86       CALL iom_rstput( 0, 0, inum0, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors 
    87       CALL iom_rstput( 0, 0, inum0, 'e1u', e1u, ktype = jp_r8 ) 
    88       CALL iom_rstput( 0, 0, inum0, 'e1v', e1v, ktype = jp_r8 ) 
    89       CALL iom_rstput( 0, 0, inum0, 'e1f', e1f, ktype = jp_r8 ) 
    90        
    91       CALL iom_rstput( 0, 0, inum0, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors 
    92       CALL iom_rstput( 0, 0, inum0, 'e2u', e2u, ktype = jp_r8 ) 
    93       CALL iom_rstput( 0, 0, inum0, 'e2v', e2v, ktype = jp_r8 ) 
    94       CALL iom_rstput( 0, 0, inum0, 'e2f', e2f, ktype = jp_r8 ) 
    95        
    96       CALL iom_rstput( 0, 0, inum0, 'e1e2u', e1e2u, ktype = jp_r8 ) 
    97       CALL iom_rstput( 0, 0, inum0, 'e1e2v', e1e2v, ktype = jp_r8 ) 
    98  
    99       CALL iom_close( inum0 ) 
    100       ! 
    101       IF( nn_timing == 1 )  CALL timing_stop('dom_wri_coordinate') 
    102       ! 
    103    END SUBROUTINE dom_wri_coordinate 
    104  
    10540 
    10641   SUBROUTINE dom_wri 
    … …  
    13267      !!                                   masks, depth and vertical scale factors 
    13368      !!---------------------------------------------------------------------- 
    134       INTEGER           ::   inum0    ! temprary units for 'mesh_mask.nc' file 
    135       INTEGER           ::   inum1    ! temprary units for 'mesh.nc'      file 
    136       INTEGER           ::   inum2    ! temprary units for 'mask.nc'      file 
    137       INTEGER           ::   inum3    ! temprary units for 'mesh_hgr.nc'  file 
    138       INTEGER           ::   inum4    ! temprary units for 'mesh_zgr.nc'  file 
    139       CHARACTER(len=21) ::   clnam0   ! filename (mesh and mask informations) 
    140       CHARACTER(len=21) ::   clnam1   ! filename (mesh informations) 
    141       CHARACTER(len=21) ::   clnam2   ! filename (mask informations) 
    142       CHARACTER(len=21) ::   clnam3   ! filename (horizontal mesh informations) 
    143       CHARACTER(len=21) ::   clnam4   ! filename (vertical   mesh informations) 
     69      INTEGER           ::   inum    ! temprary units for 'mesh_mask.nc' file 
     70      CHARACTER(len=21) ::   clnam   ! filename (mesh and mask informations) 
    14471      INTEGER           ::   ji, jj, jk   ! dummy loop indices 
    14572      INTEGER           ::   izco, izps, isco, icav 
    146       !                                   !  workspaces 
    147       REAL(wp), POINTER, DIMENSION(:,:  ) :: zprt, zprw  
    148       REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepu, zdepv 
     73      !                                
     74      REAL(wp), POINTER, DIMENSION(:,:)   ::   zprt, zprw     ! 2D workspace 
     75      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zdepu, zdepv   ! 3D workspace 
    14976      !!---------------------------------------------------------------------- 
    15077      ! 
    … …  
    15885      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    15986       
    160       clnam0 = 'mesh_mask'  ! filename (mesh and mask informations) 
    161       clnam1 = 'mesh'       ! filename (mesh informations) 
    162       clnam2 = 'mask'       ! filename (mask informations) 
    163       clnam3 = 'mesh_hgr'   ! filename (horizontal mesh informations) 
    164       clnam4 = 'mesh_zgr'   ! filename (vertical   mesh informations) 
    165        
    166       SELECT CASE ( MOD(nn_msh, 3) ) 
    167          !                                  ! ============================ 
    168       CASE ( 1 )                            !  create 'mesh_mask.nc' file 
    169          !                                  ! ============================ 
    170          CALL iom_open( TRIM(clnam0), inum0, ldwrt = .TRUE., kiolib = jprstlib ) 
    171          inum2 = inum0                                            ! put all the informations 
    172          inum3 = inum0                                            ! in unit inum0 
    173          inum4 = inum0 
    174           
    175          !                                  ! ============================ 
    176       CASE ( 2 )                            !  create 'mesh.nc' and  
    177          !                                  !         'mask.nc' files 
    178          !                                  ! ============================ 
    179          CALL iom_open( TRIM(clnam1), inum1, ldwrt = .TRUE., kiolib = jprstlib ) 
    180          CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib ) 
    181          inum3 = inum1                                            ! put mesh informations  
    182          inum4 = inum1                                            ! in unit inum1  
    183          !                                  ! ============================ 
    184       CASE ( 0 )                            !  create 'mesh_hgr.nc' 
    185          !                                  !         'mesh_zgr.nc' and 
    186          !                                  !         'mask.nc'     files 
    187          !                                  ! ============================ 
    188          CALL iom_open( TRIM(clnam2), inum2, ldwrt = .TRUE., kiolib = jprstlib ) 
    189          CALL iom_open( TRIM(clnam3), inum3, ldwrt = .TRUE., kiolib = jprstlib ) 
    190          CALL iom_open( TRIM(clnam4), inum4, ldwrt = .TRUE., kiolib = jprstlib ) 
    191          ! 
    192       END SELECT 
    193  
     87      clnam = 'mesh_mask'  ! filename (mesh and mask informations) 
     88       
     89      !                                  ! ============================ 
     90      !                                  !  create 'mesh_mask.nc' file 
     91      !                                  ! ============================ 
     92      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib ) 
     93      ! 
    19494      !                                                         ! global domain size 
    195       CALL iom_rstput( 0, 0, inum2, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 ) 
    196       CALL iom_rstput( 0, 0, inum2, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 ) 
    197       CALL iom_rstput( 0, 0, inum2, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 ) 
     95      CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 ) 
     96      CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 ) 
     97      CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpkglo, wp), ktype = jp_i4 ) 
    19898 
    19999      !                                                         ! domain characteristics 
    200       CALL iom_rstput( 0, 0, inum2, 'jperio', REAL( jperio, wp), ktype = jp_i4 ) 
     100      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 ) 
    201101      !                                                         ! type of vertical coordinate 
    202102      IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF 
    203103      IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF 
    204104      IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF 
    205       CALL iom_rstput( 0, 0, inum2, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 ) 
    206       CALL iom_rstput( 0, 0, inum2, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 ) 
    207       CALL iom_rstput( 0, 0, inum2, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 ) 
     105      CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 ) 
     106      CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 ) 
     107      CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 ) 
    208108      !                                                         ! ocean cavities under iceshelves 
    209109      IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF 
    210       CALL iom_rstput( 0, 0, inum2, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 ) 
     110      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 ) 
    211111   
    212       !                                                         ! masks (inum2)  
    213       CALL iom_rstput( 0, 0, inum2, 'tmask', tmask, ktype = jp_i1 )     !    ! land-sea mask 
    214       CALL iom_rstput( 0, 0, inum2, 'umask', umask, ktype = jp_i1 ) 
    215       CALL iom_rstput( 0, 0, inum2, 'vmask', vmask, ktype = jp_i1 ) 
    216       CALL iom_rstput( 0, 0, inum2, 'fmask', fmask, ktype = jp_i1 ) 
     112      !                                                         ! masks 
     113      CALL iom_rstput( 0, 0, inum, 'tmask', tmask, ktype = jp_i1 )     !    ! land-sea mask 
     114      CALL iom_rstput( 0, 0, inum, 'umask', umask, ktype = jp_i1 ) 
     115      CALL iom_rstput( 0, 0, inum, 'vmask', vmask, ktype = jp_i1 ) 
     116      CALL iom_rstput( 0, 0, inum, 'fmask', fmask, ktype = jp_i1 ) 
    217117       
    218118      CALL dom_uniq( zprw, 'T' ) 
    219119      DO jj = 1, jpj 
    220120         DO ji = 1, jpi 
    221             jk=mikt(ji,jj)  
    222             zprt(ji,jj) = tmask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask 
     121            zprt(ji,jj) = ssmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask 
    223122         END DO 
    224123      END DO                             !    ! unique point mask 
    225       CALL iom_rstput( 0, 0, inum2, 'tmaskutil', zprt, ktype = jp_i1 )   
     124      CALL iom_rstput( 0, 0, inum, 'tmaskutil', zprt, ktype = jp_i1 )   
    226125      CALL dom_uniq( zprw, 'U' ) 
    227126      DO jj = 1, jpj 
    228127         DO ji = 1, jpi 
    229             jk=miku(ji,jj)  
    230             zprt(ji,jj) = umask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask 
     128            zprt(ji,jj) = ssumask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask 
    231129         END DO 
    232130      END DO 
    233       CALL iom_rstput( 0, 0, inum2, 'umaskutil', zprt, ktype = jp_i1 )   
     131      CALL iom_rstput( 0, 0, inum, 'umaskutil', zprt, ktype = jp_i1 )   
    234132      CALL dom_uniq( zprw, 'V' ) 
    235133      DO jj = 1, jpj 
    236134         DO ji = 1, jpi 
    237             jk=mikv(ji,jj)  
    238             zprt(ji,jj) = vmask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask 
     135            zprt(ji,jj) = ssvmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask 
    239136         END DO 
    240137      END DO 
    241       CALL iom_rstput( 0, 0, inum2, 'vmaskutil', zprt, ktype = jp_i1 )   
    242       CALL dom_uniq( zprw, 'F' ) 
    243       DO jj = 1, jpj 
    244          DO ji = 1, jpi 
    245             jk=mikf(ji,jj)  
    246             zprt(ji,jj) = fmask(ji,jj,jk) * zprw(ji,jj)                        !    ! unique point mask 
    247          END DO 
    248       END DO 
    249       CALL iom_rstput( 0, 0, inum2, 'fmaskutil', zprt, ktype = jp_i1 )   
     138      CALL iom_rstput( 0, 0, inum, 'vmaskutil', zprt, ktype = jp_i1 )   
     139!!gm  ssfmask has been removed  ==>> find another solution to defined fmaskutil 
     140!!    Here we just remove the output of fmaskutil. 
     141!      CALL dom_uniq( zprw, 'F' ) 
     142!      DO jj = 1, jpj 
     143!         DO ji = 1, jpi 
     144!            zprt(ji,jj) = ssfmask(ji,jj) * zprw(ji,jj)                        !    ! unique point mask 
     145!         END DO 
     146!      END DO 
     147!      CALL iom_rstput( 0, 0, inum, 'fmaskutil', zprt, ktype = jp_i1 )   
     148!!gm 
    250149 
    251150      !                                                         ! horizontal mesh (inum3) 
    252       CALL iom_rstput( 0, 0, inum3, 'glamt', glamt, ktype = jp_r8 )     !    ! latitude 
    253       CALL iom_rstput( 0, 0, inum3, 'glamu', glamu, ktype = jp_r8 ) 
    254       CALL iom_rstput( 0, 0, inum3, 'glamv', glamv, ktype = jp_r8 ) 
    255       CALL iom_rstput( 0, 0, inum3, 'glamf', glamf, ktype = jp_r8 ) 
    256        
    257       CALL iom_rstput( 0, 0, inum3, 'gphit', gphit, ktype = jp_r8 )     !    ! longitude 
    258       CALL iom_rstput( 0, 0, inum3, 'gphiu', gphiu, ktype = jp_r8 ) 
    259       CALL iom_rstput( 0, 0, inum3, 'gphiv', gphiv, ktype = jp_r8 ) 
    260       CALL iom_rstput( 0, 0, inum3, 'gphif', gphif, ktype = jp_r8 ) 
    261        
    262       CALL iom_rstput( 0, 0, inum3, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors 
    263       CALL iom_rstput( 0, 0, inum3, 'e1u', e1u, ktype = jp_r8 ) 
    264       CALL iom_rstput( 0, 0, inum3, 'e1v', e1v, ktype = jp_r8 ) 
    265       CALL iom_rstput( 0, 0, inum3, 'e1f', e1f, ktype = jp_r8 ) 
    266        
    267       CALL iom_rstput( 0, 0, inum3, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors 
    268       CALL iom_rstput( 0, 0, inum3, 'e2u', e2u, ktype = jp_r8 ) 
    269       CALL iom_rstput( 0, 0, inum3, 'e2v', e2v, ktype = jp_r8 ) 
    270       CALL iom_rstput( 0, 0, inum3, 'e2f', e2f, ktype = jp_r8 ) 
    271        
    272       CALL iom_rstput( 0, 0, inum3, 'ff_f', ff_f, ktype = jp_r8 )           !    ! coriolis factor 
    273       CALL iom_rstput( 0, 0, inum3, 'ff_t', ff_t, ktype = jp_r8 ) 
     151      CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 )     !    ! latitude 
     152      CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 ) 
     153      CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 ) 
     154      CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 ) 
     155       
     156      CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 )     !    ! longitude 
     157      CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 ) 
     158      CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 ) 
     159      CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 ) 
     160       
     161      CALL iom_rstput( 0, 0, inum, 'e1t', e1t, ktype = jp_r8 )         !    ! e1 scale factors 
     162      CALL iom_rstput( 0, 0, inum, 'e1u', e1u, ktype = jp_r8 ) 
     163      CALL iom_rstput( 0, 0, inum, 'e1v', e1v, ktype = jp_r8 ) 
     164      CALL iom_rstput( 0, 0, inum, 'e1f', e1f, ktype = jp_r8 ) 
     165       
     166      CALL iom_rstput( 0, 0, inum, 'e2t', e2t, ktype = jp_r8 )         !    ! e2 scale factors 
     167      CALL iom_rstput( 0, 0, inum, 'e2u', e2u, ktype = jp_r8 ) 
     168      CALL iom_rstput( 0, 0, inum, 'e2v', e2v, ktype = jp_r8 ) 
     169      CALL iom_rstput( 0, 0, inum, 'e2f', e2f, ktype = jp_r8 ) 
     170       
     171      CALL iom_rstput( 0, 0, inum, 'ff_f', ff_f, ktype = jp_r8 )           !    ! coriolis factor 
     172      CALL iom_rstput( 0, 0, inum, 'ff_t', ff_t, ktype = jp_r8 ) 
    274173       
    275174      ! note that mbkt is set to 1 over land ==> use surface tmask 
    276175      zprt(:,:) = ssmask(:,:) * REAL( mbkt(:,:) , wp ) 
    277       CALL iom_rstput( 0, 0, inum4, 'mbathy', zprt, ktype = jp_i4 )     !    ! nb of ocean T-points 
     176      CALL iom_rstput( 0, 0, inum, 'mbathy', zprt, ktype = jp_i4 )     !    ! nb of ocean T-points 
    278177      zprt(:,:) = ssmask(:,:) * REAL( mikt(:,:) , wp ) 
    279       CALL iom_rstput( 0, 0, inum4, 'misf', zprt, ktype = jp_i4 )       !    ! nb of ocean T-points 
     178      CALL iom_rstput( 0, 0, inum, 'misf', zprt, ktype = jp_i4 )       !    ! nb of ocean T-points 
    280179      zprt(:,:) = ssmask(:,:) * REAL( risfdep(:,:) , wp ) 
    281       CALL iom_rstput( 0, 0, inum4, 'isfdraft', zprt, ktype = jp_r8 )       !    ! nb of ocean T-points 
     180      CALL iom_rstput( 0, 0, inum, 'isfdraft', zprt, ktype = jp_r8 )       !    ! nb of ocean T-points 
    282181             
    283       IF( ln_sco ) THEN                                         ! s-coordinate 
    284          CALL iom_rstput( 0, 0, inum4, 'e3t_0', e3t_0 )         !    ! scale factors 
    285          CALL iom_rstput( 0, 0, inum4, 'e3u_0', e3u_0 ) 
    286          CALL iom_rstput( 0, 0, inum4, 'e3v_0', e3v_0 ) 
    287          CALL iom_rstput( 0, 0, inum4, 'e3w_0', e3w_0 ) 
    288          ! 
    289          CALL dom_stiff( zprt ) 
    290          CALL iom_rstput( 0, 0, inum4, 'stiffness', zprt )      !    ! Max. grid stiffness ratio 
    291          ! 
    292          CALL iom_rstput( 0, 0, inum4, 'gdept_1d' , gdept_1d )  !    ! stretched system 
    293          CALL iom_rstput( 0, 0, inum4, 'gdepw_1d' , gdepw_1d ) 
    294          CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r8 ) 
    295          CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r8 ) 
    296       ENDIF 
    297        
    298       IF( ln_zps ) THEN                                         ! z-coordinate - partial steps 
    299          ! 
    300          IF( nn_msh <= 6 ) THEN                                   !    ! 3D vertical scale factors 
    301             CALL iom_rstput( 0, 0, inum4, 'e3t_0', e3t_0 )          
    302             CALL iom_rstput( 0, 0, inum4, 'e3u_0', e3u_0 ) 
    303             CALL iom_rstput( 0, 0, inum4, 'e3v_0', e3v_0 ) 
    304             CALL iom_rstput( 0, 0, inum4, 'e3w_0', e3w_0 ) 
    305          ELSE                                                   !    ! 2D masked bottom ocean scale factors 
    306             DO jj = 1,jpj    
    307                DO ji = 1,jpi 
    308                   e3tp(ji,jj) = e3t_0(ji,jj,mbkt(ji,jj)) * ssmask(ji,jj) 
    309                   e3wp(ji,jj) = e3w_0(ji,jj,mbkt(ji,jj)) * ssmask(ji,jj) 
    310                END DO 
    311             END DO 
    312             CALL iom_rstput( 0, 0, inum4, 'e3t_ps', e3tp )       
    313             CALL iom_rstput( 0, 0, inum4, 'e3w_ps', e3wp ) 
    314          END IF 
    315          ! 
    316          IF( nn_msh <= 3 ) THEN                                   !    ! 3D depth 
    317             CALL iom_rstput( 0, 0, inum4, 'gdept_0', gdept_0, ktype = jp_r8 ) 
    318             DO jk = 1,jpk    
    319                DO jj = 1, jpjm1    
    320                   DO ji = 1, fs_jpim1   ! vector opt. 
    321                      zdepu(ji,jj,jk) = MIN( gdept_0(ji,jj,jk) , gdept_0(ji+1,jj  ,jk) ) 
    322                      zdepv(ji,jj,jk) = MIN( gdept_0(ji,jj,jk) , gdept_0(ji  ,jj+1,jk) ) 
    323                   END DO 
    324                END DO 
    325             END DO 
    326             CALL lbc_lnk( zdepu, 'U', 1. )   ;   CALL lbc_lnk( zdepv, 'V', 1. ) 
    327             CALL iom_rstput( 0, 0, inum4, 'gdepu', zdepu, ktype = jp_r8 ) 
    328             CALL iom_rstput( 0, 0, inum4, 'gdepv', zdepv, ktype = jp_r8 ) 
    329             CALL iom_rstput( 0, 0, inum4, 'gdepw_0', gdepw_0, ktype = jp_r8 ) 
    330          ELSE                                                   !    ! 2D bottom depth 
    331             DO jj = 1,jpj    
    332                DO ji = 1,jpi 
    333                   zprt(ji,jj) = gdept_0(ji,jj,mbkt(ji,jj)  ) * ssmask(ji,jj) 
    334                   zprw(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) * ssmask(ji,jj) 
    335                END DO 
    336             END DO 
    337             CALL iom_rstput( 0, 0, inum4, 'hdept', zprt, ktype = jp_r8 ) 
    338             CALL iom_rstput( 0, 0, inum4, 'hdepw', zprw, ktype = jp_r8 ) 
    339          ENDIF 
    340          ! 
    341          CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d )   !    ! reference z-coord. 
    342          CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d ) 
    343          CALL iom_rstput( 0, 0, inum4, 'e3t_1d'  , e3t_1d   ) 
    344          CALL iom_rstput( 0, 0, inum4, 'e3w_1d'  , e3w_1d   ) 
    345       ENDIF 
    346        
    347       IF( ln_zco ) THEN 
    348          !                                                      ! z-coordinate - full steps 
    349          CALL iom_rstput( 0, 0, inum4, 'gdept_1d', gdept_1d )   !    ! depth 
    350          CALL iom_rstput( 0, 0, inum4, 'gdepw_1d', gdepw_1d ) 
    351          CALL iom_rstput( 0, 0, inum4, 'e3t_1d'  , e3t_1d   )   !    ! scale factors 
    352          CALL iom_rstput( 0, 0, inum4, 'e3w_1d'  , e3w_1d   ) 
    353       ENDIF 
     182      CALL iom_rstput( 0, 0, inum, 'e3t_0', e3t_0 )         !    ! scale factors 
     183      CALL iom_rstput( 0, 0, inum, 'e3u_0', e3u_0 ) 
     184      CALL iom_rstput( 0, 0, inum, 'e3v_0', e3v_0 ) 
     185      CALL iom_rstput( 0, 0, inum, 'e3w_0', e3w_0 ) 
     186      ! 
     187      CALL dom_stiff( zprt ) 
     188      CALL iom_rstput( 0, 0, inum, 'stiffness', zprt )      !    ! Max. grid stiffness ratio 
     189      ! 
     190      CALL iom_rstput( 0, 0, inum, 'gdept_1d' , gdept_1d )  !    ! stretched system 
     191      CALL iom_rstput( 0, 0, inum, 'gdepw_1d' , gdepw_1d ) 
     192      CALL iom_rstput( 0, 0, inum, 'gdept_0', gdept_0, ktype = jp_r8 ) 
     193      CALL iom_rstput( 0, 0, inum, 'gdepw_0', gdepw_0, ktype = jp_r8 ) 
     194       
    354195      !                                     ! ============================ 
    355       !                                     !        close the files  
     196      CALL iom_close( inum )                !        close the files  
    356197      !                                     ! ============================ 
    357       SELECT CASE ( MOD(nn_msh, 3) ) 
    358       CASE ( 1 )                 
    359          CALL iom_close( inum0 ) 
    360       CASE ( 2 ) 
    361          CALL iom_close( inum1 ) 
    362          CALL iom_close( inum2 ) 
    363       CASE ( 0 ) 
    364          CALL iom_close( inum2 ) 
    365          CALL iom_close( inum3 ) 
    366          CALL iom_close( inum4 ) 
    367       END SELECT 
    368198      ! 
    369199      CALL wrk_dealloc( jpi, jpj, zprt, zprw ) 
    … …  
    384214      !!                2) check which elements have been changed 
    385215      !!---------------------------------------------------------------------- 
    386       ! 
    387216      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   !  
    388217      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   !  

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r6667 r6717  
    2424   !!   dom_zgr       : read or set the ocean vertical coordinate system 
    2525   !!   zgr_read      : read the vertical domain coordinate and mask in domain_cfg file 
    26    !!   zgr_tb_level  : ocean top and bottom level for t-, u, and v-points with 1 as minimum value 
     26   !!   zgr_top_bot   : ocean top and bottom level for t-, u, and v-points with 1 as minimum value 
    2727   !!--------------------------------------------------------------------- 
    2828   USE oce            ! ocean variables 
    … …  
    7373      INTEGER  ::   ioptio, ibat, ios   ! local integer 
    7474      REAL(wp) ::   zrefdep             ! depth of the reference level (~10m) 
    75       !! 
    76 !      NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav, ln_linssh 
    7775      !!---------------------------------------------------------------------- 
    7876      ! 
    7977      IF( nn_timing == 1 )   CALL timing_start('dom_zgr') 
    8078      ! 
    81 !      REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate 
    82 !      READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901 ) 
    83 !901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp ) 
    84 ! 
    85 !      REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate 
    86 !      READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 ) 
    87 !902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp ) 
    88 !      IF(lwm) WRITE ( numond, namzgr ) 
    89  
    9079      IF(lwp) THEN                     ! Control print 
    9180         WRITE(numout,*) 
    … …  
    11099      ELSE                          !==  User defined configuration  ==! 
    111100         IF(lwp) WRITE(numout,*) 
    112          IF(lwp) WRITE(numout,*) '          User defined horizontal mesh (usr_def_hgr)' 
     101         IF(lwp) WRITE(numout,*) '          User defined vertical mesh (usr_def_zgr)' 
    113102         ! 
    114103         CALL usr_def_zgr( ln_zco  , ln_zps  , ln_sco, ln_isfcav,   &  
    … …  
    130119      IF(lwp) THEN                     ! Control print 
    131120         WRITE(numout,*) 
    132          WRITE(numout,*) '   Read in domain_cfg.nc or user defined type of vertical coordinate:' 
     121         WRITE(numout,*) '   Type of vertical coordinate (read in domain_cfg.nc or set through user defined routines) :' 
    133122         WRITE(numout,*) '      z-coordinate - full steps      ln_zco    = ', ln_zco 
    134123         WRITE(numout,*) '      z-coordinate - partial steps   ln_zps    = ', ln_zps 
    … …  
    145134 
    146135      !                                ! top/bottom ocean level indices for t-, u- and v-points (f-point also for top) 
    147       CALL zgr_tb_level( k_top, k_bot )      ! with a minimum value set to 1 
     136      CALL zgr_top_bot( k_top, k_bot )      ! with a minimum value set to 1 
    148137       
    149138 
    … …  
    207196      IF(lwp) THEN 
    208197         WRITE(numout,*) 
    209          WRITE(numout,*) 'hgr_read : read the vertical coordinates in "domain_cfg.nc" file' 
    210          WRITE(numout,*) '~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo 
     198         WRITE(numout,*) '   zgr_read : read the vertical coordinates in "domain_cfg.nc" file' 
     199         WRITE(numout,*) '   ~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo 
    211200      ENDIF 
    212201      ! 
    … …  
    256245 
    257246 
    258    SUBROUTINE zgr_tb_level( k_top, k_bot ) 
    259       !!---------------------------------------------------------------------- 
    260       !!                    ***  ROUTINE zgr_tb_level  *** 
     247   SUBROUTINE zgr_top_bot( k_top, k_bot ) 
     248      !!---------------------------------------------------------------------- 
     249      !!                    ***  ROUTINE zgr_top_bot  *** 
    261250      !! 
    262251      !! ** Purpose :   defines the vertical index of ocean bottom (mbk. arrays) 
    … …  
    282271      ! 
    283272      IF(lwp) WRITE(numout,*) 
    284       IF(lwp) WRITE(numout,*) '    zgr_tb_level : ocean top and bottom k-index of T-, U-, V- and W-levels ' 
    285       IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~' 
     273      IF(lwp) WRITE(numout,*) '    zgr_top_bot : ocean top and bottom k-index of T-, U-, V- and W-levels ' 
     274      IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~' 
    286275      ! 
    287276      mikt(:,:) = MAX( k_top(:,:) , 1 )    ! top    ocean k-index of T-level (=1 over land) 
    … …  
    313302      IF( nn_timing == 1 )  CALL timing_stop('zgr_top_level') 
    314303      ! 
    315    END SUBROUTINE zgr_tb_level 
     304   END SUBROUTINE zgr_top_bot 
    316305 
    317306   !!====================================================================== 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DOM/istate.F90

    r6596 r6717  
    1414   !!            3.3  !  2010-10  (C. Ethe) merge TRC-TRA 
    1515   !!            3.4  !  2011-04  (G. Madec) Merge of dtatem and dtasal & suppression of tb,tn/sb,sn  
    16    !!            3.7  !  2016-04  (S. Flavoni) change configuration's interface: 
    17    !!                              read file or CALL usr_def module to compute initial state (example given for GYRE) 
     16   !!            3.7  !  2016-04  (S. Flavoni) introduce user defined initial state  
    1817   !!---------------------------------------------------------------------- 
    1918 
    … …  
    2221   !!   istate_uvg    : initial velocity in geostropic balance 
    2322   !!---------------------------------------------------------------------- 
    24    USE oce             ! ocean dynamics and active tracers  
    25    USE dom_oce         ! ocean space and time domain  
    26    USE c1d             ! 1D vertical configuration 
    27    USE daymod          ! calendar 
    28    USE eosbn2          ! eq. of state, Brunt Vaisala frequency (eos     routine) 
    29    USE ldftra          ! lateral physics: ocean active tracers 
    30    USE zdf_oce         ! ocean vertical physics 
    31    USE phycst          ! physical constants 
    32    USE dtatsd          ! data temperature and salinity   (dta_tsd routine) 
    33    USE dtauvd          ! data: U & V current             (dta_uvd routine) 
     23   USE oce            ! ocean dynamics and active tracers  
     24   USE dom_oce        ! ocean space and time domain  
     25   USE daymod         ! calendar 
     26   USE divhor         ! horizontal divergence            (div_hor routine) 
     27   USE dtatsd         ! data temperature and salinity   (dta_tsd routine) 
     28   USE dtauvd         ! data: U & V current             (dta_uvd routine) 
    3429   USE domvvl          ! varying vertical mesh 
    3530   USE iscplrst        ! ice sheet coupling 
    36    USE usrdef          ! User defined routine 
     31   USE usrdef_istate   ! User defined initial state 
    3732   ! 
    3833   USE in_out_manager  ! I/O manager 
    … …  
    4742 
    4843   PUBLIC   istate_init   ! routine called by step.F90 
    49    !SF PUBLIC   ini_read      ! subroutine ini_read  
    5044 
    5145   !! * Substitutions 
    … …  
    7064      IF( nn_timing == 1 )   CALL timing_start('istate_init') 
    7165      ! 
     66      IF(lwp) WRITE(numout,*) 
     67      IF(lwp) WRITE(numout,*) 'istate_init : Initialization of the dynamics and tracers' 
     68      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
    7269 
    73       IF(lwp) WRITE(numout,*) 
    74       IF(lwp) WRITE(numout,*) 'istate_ini : Initialization of the dynamics and tracers' 
    75       IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 
    76  
    77      !SF initialisation of T & S with data file 
     70!!gm  Why not include in the first call of dta_tsd ?   
     71!!gm  probably associated with the use of internal damping... 
    7872                     CALL dta_tsd_init        ! Initialisation of T & S input data 
    79       IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data 
     73!!gm to be moved in usrdef of C1D case 
     74!      IF( lk_c1d )   CALL dta_uvd_init        ! Initialization of U & V input data 
     75!!gm 
    8076 
    8177      rhd  (:,:,:  ) = 0._wp   ;   rhop (:,:,:  ) = 0._wp      ! set one for all to 0 at level jpk 
    … …  
    8783         !                                    ! ------------------- 
    8884         CALL rst_read                        ! Read the restart file 
    89          IF (ln_iscpl)       CALL iscpl_stp   ! extraloate restart to wet and dry 
     85         IF (ln_iscpl)       CALL iscpl_stp   ! extrapolate restart to wet and dry 
    9086         CALL day_init                        ! model calendar (using both namelist and restart infos) 
    91       ELSE 
    92          !                                    ! Start from rest 
     87         ! 
     88      ELSE                                    ! Start from rest 
    9389         !                                    ! --------------- 
    9490         numror = 0                           ! define numror = 0 -> no restart file to read 
    … …  
    9692         CALL day_init                        ! model calendar (using both namelist and restart infos) 
    9793         !                                    ! Initialization of ocean to zero 
    98          !   before fields      !       now fields      
    99          sshb (:,:)   = 0._wp   ;   sshn (:,:)   = 0._wp 
    100          ub   (:,:,:) = 0._wp   ;   un   (:,:,:) = 0._wp 
    101          vb   (:,:,:) = 0._wp   ;   vn   (:,:,:) = 0._wp   
    102                                     hdivn(:,:,:) = 0._wp 
    10394         ! 
    104          IF( ln_tsd_init ) THEN               ! read 3D T and S data at nit000 
    105             CALL dta_tsd( nit000, tsb )   
     95         IF( ln_tsd_init ) THEN                
     96            CALL dta_tsd( nit000, tsb )       ! read 3D T and S data at nit000 
     97            ! 
     98            sshb(:,:)   = 0._wp               ! set the ocean at rest 
     99            ub  (:,:,:) = 0._wp 
     100            vb  (:,:,:) = 0._wp   
     101            ! 
    106102         ELSE                                 ! user defined initial T and S 
    107             CALL usr_def_ini( tsb )                 
     103            CALL usr_def_istate( gdept_b, tmask, tsb, ub, vb, sshb  )          
    108104         ENDIF 
    109          tsn(:,:,:,:) = tsb(:,:,:,:)          ! set now to before values 
     105         tsn  (:,:,:,:) = tsb (:,:,:,:)       ! set now values from to before ones 
     106         sshn (:,:)     = sshb(:,:)    
     107         un   (:,:,:)   = ub  (:,:,:) 
     108         vn   (:,:,:)   = vb  (:,:,:) 
     109         hdivn(:,:,jpk) = 0._wp               ! bottom divergence set one for 0 to zero at jpk level 
     110         CALL div_hor( 0 )                    ! compute interior hdivn value   
     111!!gm                                    hdivn(:,:,:) = 0._wp 
     112 
     113!!gm POTENTIAL BUG : 
     114!!gm  ISSUE :  if sshb /= 0  then, in non linear free surface, the e3._n, e3._b should be recomputed 
     115!!             as well as gdept and gdepw....   !!!!!  
     116!!      ===>>>>   probably a call to domvvl initialisation here.... 
     117 
     118 
    110119         ! 
    111          IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000 
    112             CALL wrk_alloc( jpi,jpj,jpk,2,   zuvd ) 
    113             CALL dta_uvd( nit000, zuvd ) 
    114             ub(:,:,:) = zuvd(:,:,:,1) ;  un(:,:,:) = ub(:,:,:) 
    115             vb(:,:,:) = zuvd(:,:,:,2) ;  vn(:,:,:) = vb(:,:,:) 
    116             CALL wrk_dealloc( jpi,jpj,jpk,2,   zuvd ) 
    117          ENDIF 
     120!!gm to be moved in usrdef of C1D case 
     121!         IF ( ln_uvd_init .AND. lk_c1d ) THEN ! read 3D U and V data at nit000 
     122!            CALL wrk_alloc( jpi,jpj,jpk,2,   zuvd ) 
     123!            CALL dta_uvd( nit000, zuvd ) 
     124!            ub(:,:,:) = zuvd(:,:,:,1) ;  un(:,:,:) = ub(:,:,:) 
     125!            vb(:,:,:) = zuvd(:,:,:,2) ;  vn(:,:,:) = vb(:,:,:) 
     126!            CALL wrk_dealloc( jpi,jpj,jpk,2,   zuvd ) 
     127!         ENDIF 
    118128         ! 
    119129!!gm This is to be changed !!!! 
    120          ! - ML - sshn could be modified by istate_eel, so that initialization of e3t_b is done here 
    121          IF( .NOT.ln_linssh ) THEN 
    122             DO jk = 1, jpk 
    123                e3t_b(:,:,jk) = e3t_n(:,:,jk) 
    124             END DO 
    125          ENDIF 
     130!         ! - ML - sshn could be modified by istate_eel, so that initialization of e3t_b is done here 
     131!         IF( .NOT.ln_linssh ) THEN 
     132!            DO jk = 1, jpk 
     133!               e3t_b(:,:,jk) = e3t_n(:,:,jk) 
     134!            END DO 
     135!         ENDIF 
    126136!!gm  
    127137         !  

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r6140 r6717  
    789789                  ENDIF 
    790790                  IF( PRESENT(pv_r3d) ) THEN 
    791                      IF( idom == jpdom_data ) THEN                                  ; icnt(3) = jpkdta 
     791                     IF( idom == jpdom_data ) THEN                                  ; icnt(3) = jpkglo 
    792792                     ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN            ; istart(3) = kstart(3); icnt(3) = kcount(3) 
    793793                     ELSE                                                           ; icnt(3) = jpk 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90

    r6140 r6717  
    1818   PRIVATE 
    1919 
    20    INTEGER, PARAMETER, PUBLIC ::   jpdom_data          = 1   !: ( 1  :jpidta, 1  :jpjdta) 
     20   INTEGER, PARAMETER, PUBLIC ::   jpdom_data          = 1   !: ( 1  :jpiglo, 1  :jpjglo)    !!gm to be suppressed 
    2121   INTEGER, PARAMETER, PUBLIC ::   jpdom_global        = 2   !: ( 1  :jpiglo, 1  :jpjglo) 
    2222   INTEGER, PARAMETER, PUBLIC ::   jpdom_local         = 3   !: One of the 3 following cases 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90

    r6596 r6717  
    66      !!     FOR USING THIS VERSION, A PREPROCESSING TRAITMENT IS RECOMMENDED 
    77      !!     FOR DEFINING BETTER CUTTING OUT. 
    8       !!       This routine is used with a the bathymetry file. 
     8      !!       This routine requires the presence of the "domain_cfg.nc" file. 
    99      !!       In this version, the land processors are avoided and the adress 
    1010      !!     processor (nproc, narea,noea, ...) are calculated again. 
    … …  
    3232      !!                    nono      : number for local neighboring processor 
    3333      !! 
    34       !! History : 
    35       !!        !  94-11  (M. Guyon)  Original code 
    36       !!        !  95-04  (J. Escobar, M. Imbard) 
    37       !!        !  98-02  (M. Guyon)  FETI method 
    38       !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions 
    39       !!   9.0  !  04-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1 
     34      !! History :       !  1994-11  (M. Guyon)  Original code 
     35      !!  OPA            !  1995-04  (J. Escobar, M. Imbard) 
     36      !!                 !  1998-02  (M. Guyon)  FETI method 
     37      !!                 !  1998-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions 
     38      !!  NEMO      1.0  !  2004-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1 
     39      !!            4.0  !  2016-06  (G. Madec)  use domain_cfg file instead of bathymetry file 
    4040      !!---------------------------------------------------------------------- 
    4141      USE in_out_manager  ! I/O Manager 
    … …  
    6565         ione  , ionw  , iose  , iosw  ,   &  !    "           " 
    6666         ibne  , ibnw  , ibse  , ibsw         !    "           " 
    67       INTEGER,  DIMENSION(jpiglo,jpjglo) ::   & 
    68          imask                                ! temporary global workspace 
    69       REAL(wp), DIMENSION(jpiglo,jpjglo) ::   & 
    70          zdta, zdtaisf                     ! temporary data workspace 
    71       REAL(wp) ::   zidom , zjdom          ! temporary scalars 
    72  
    73       ! read namelist for ln_zco 
    74       NAMELIST/namzgr/ ln_zco, ln_zps, ln_sco, ln_isfcav 
    75  
     67      INTEGER,  DIMENSION(jpiglo,jpjglo) ::   imask        ! global workspace 
     68      REAL(wp), DIMENSION(jpiglo,jpjglo) ::   zbot, ztop   ! global workspace 
     69      REAL(wp) ::   zidom , zjdom          ! local scalars 
    7670      !!---------------------------------------------------------------------- 
    77       !!  OPA 9.0 , LOCEAN-IPSL (2005)  
     71      !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    7872      !! $Id$ 
    79       !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
     73      !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    8074      !!---------------------------------------------------------------------- 
    8175 
    82       REWIND( numnam_ref )              ! Namelist namzgr in reference namelist : Vertical coordinate 
    83       READ  ( numnam_ref, namzgr, IOSTAT = ios, ERR = 901) 
    84 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in reference namelist', lwp ) 
    85  
    86       REWIND( numnam_cfg )              ! Namelist namzgr in configuration namelist : Vertical coordinate 
    87       READ  ( numnam_cfg, namzgr, IOSTAT = ios, ERR = 902 ) 
    88 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzgr in configuration namelist', lwp ) 
    89       IF(lwm) WRITE ( numond, namzgr ) 
    90  
    9176      IF(lwp)WRITE(numout,*) 
    92       IF(lwp)WRITE(numout,*) 'mpp_init : Message Passing MPI' 
    93       IF(lwp)WRITE(numout,*) '~~~~~~~~' 
     77      IF(lwp)WRITE(numout,*) 'mpp_init_2 : Message Passing MPI' 
     78      IF(lwp)WRITE(numout,*) '~~~~~~~~~~' 
    9479      IF(lwp)WRITE(numout,*) ' ' 
    9580 
    96       IF( jpni*jpnj < jpnij ) CALL ctl_stop( ' jpnij > jpni x jpnj impossible' ) 
     81      IF( jpni*jpnj < jpnij )   CALL ctl_stop( ' jpnij > jpni x jpnj impossible' ) 
    9782 
    9883      ! 0. initialisation 
    9984      ! ----------------- 
    100  
    101       ! open the file 
    102       ! Remember that at this level in the code, mpp is not yet initialized, so 
    103       ! the file must be open with jpdom_unknown, and kstart and kcount forced  
    104       jstartrow = 1 
    105       IF ( ln_zco ) THEN  
    106          CALL iom_open ( 'bathy_level.nc', inum )   ! Level bathymetry 
    107           ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file 
    108           ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry 
    109          CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 
    110          jstartrow = MAX(1,jstartrow) 
    111          CALL iom_get( inum, jpdom_unknown, 'Bathy_level', zdta, kstart=(/1,1+jstartrow-1/), kcount=(/jpiglo,jpjglo/) ) 
    112       ELSE 
    113          CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps 
    114          IF ( ln_isfcav ) THEN 
    115              CALL iom_get( inum, jpdom_unknown, 'Bathymetry_isf' , zdta, kstart=(/1,1/), kcount=(/jpiglo,jpjglo/) ) 
    116          ELSE 
    117              ! Optionally use a file attribute (open_ocean_jstart) to set a start row for reading from the global file 
    118              ! This allows the unextended grid bathymetry to be stored in the same file as the under ice-shelf extended bathymetry 
    119              CALL iom_getatt(inum, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 
    120              jstartrow = MAX(1,jstartrow) 
    121              CALL iom_get( inum, jpdom_unknown, 'Bathymetry' , zdta, kstart=(/1,1+jstartrow-1/), kcount=(/jpiglo,jpjglo/) ) 
    122          ENDIF 
    123       ENDIF 
    124       CALL iom_close (inum) 
    125        
    126       ! used to compute the land processor in case of not masked bathy file. 
    127       zdtaisf(:,:) = 0.0_wp 
    128       IF ( ln_isfcav ) THEN 
    129          CALL iom_open ( 'bathy_meter.nc', inum )   ! Meter bathy in case of partial steps 
    130          CALL iom_get ( inum, jpdom_unknown, 'isf_draft' , zdtaisf, kstart=(/1,1/), kcount=(/jpiglo,jpjglo/) ) 
    131       END IF 
    132       CALL iom_close (inum) 
    133  
    134       ! land/sea mask over the global domain 
    135  
    136       imask(:,:)=1 
    137       WHERE ( zdta(:,:) - zdtaisf(:,:) <= rn_isfhmin ) imask = 0 
     85      CALL iom_open( 'domain_cfg', inum ) 
     86      ! 
     87      !                                   ! ocean top and bottom level 
     88      CALL iom_get( inum, jpdom_data, 'bottom level' , zbot    )  ! nb of ocean T-points 
     89      CALL iom_get( inum, jpdom_data, 'top    level' , ztop     )   ! nb of ocean T-points (ISF) 
     90      ! 
     91      CALL iom_close( inum ) 
     92      ! 
     93      ! 2D ocean mask (=1 if at least one level of the water column is ocean, =0 otherwise) 
     94      WHERE( zbot(:,:) - ztop(:,:) + 1 > 0 )   ;   imask(:,:) = 1 
     95      ELSEWHERE                                ;   imask(:,:) = 0 
     96      END WHERE 
    13897 
    13998      !  1. Dimension arrays for subdomains 
    … …  
    320279         DO jj = 1+jprecj, ilj-jprecj 
    321280            DO  ji = 1+jpreci, ili-jpreci 
    322                IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1) isurf = isurf+1 
     281               IF( imask(ji+iimppt(ii,ij)-1, jj+ijmppt(ii,ij)-1) == 1)   isurf = isurf+1 
    323282            END DO 
    324283         END DO 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/OBS/obs_prep.F90

    r6140 r6717  
    1313   !!   obs_sor       : Sort the observation arrays 
    1414   !!--------------------------------------------------------------------- 
    15    !! * Modules used 
    16    USE par_kind, ONLY : & ! Precision variables 
    17       & wp    
     15   USE par_kind, ONLY : wp ! Precision variables 
    1816   USE in_out_manager     ! I/O manager 
    1917   USE obs_profiles_def   ! Definitions for storage arrays for profiles 
    … …  
    2422   USE obs_inter_sup      ! Interpolation support 
    2523   USE obs_oper           ! Observation operators 
    26    USE lib_mpp, ONLY : & 
    27       & ctl_warn, ctl_stop 
     24   USE lib_mpp, ONLY :   ctl_warn, ctl_stop 
    2825 
    2926   IMPLICIT NONE 
    30  
    31    !! * Routine accessibility 
    3227   PRIVATE 
    3328 
    34    PUBLIC & 
    35       & obs_pre_prof, &    ! First level check and screening of profile obs 
    36       & obs_pre_surf, &    ! First level check and screening of surface obs 
    37       & calc_month_len     ! Calculate the number of days in the months of a year 
     29   PUBLIC   obs_pre_prof     ! First level check and screening of profile obs 
     30   PUBLIC   obs_pre_surf     ! First level check and screening of surface obs 
     31   PUBLIC   calc_month_len   ! Calculate the number of days in the months of a year 
    3832 
    3933   !!---------------------------------------------------------------------- 
    … …  
    6357      !!        !  2015-02  (M. Martin) Combined routine for surface types. 
    6458      !!---------------------------------------------------------------------- 
    65       !! * Modules used 
    66       USE domstp              ! Domain: set the time-step 
    6759      USE par_oce             ! Ocean parameters 
    68       USE dom_oce, ONLY : &   ! Geographical information 
    69          & glamt,   & 
    70          & gphit,   & 
    71          & tmask,   & 
    72          & nproc 
     60      USE dom_oce, ONLY       :   glamt, gphit, tmask, nproc   ! Geographical information 
    7361      !! * Arguments 
    7462      TYPE(obs_surf), INTENT(INOUT) :: surfdata    ! Full set of surface data 
    7563      TYPE(obs_surf), INTENT(INOUT) :: surfdataqc   ! Subset of surface data not failing screening 
    7664      LOGICAL, INTENT(IN) :: ld_nea         ! Switch for rejecting observation near land 
    77       !! * Local declarations 
     65      ! 
    7866      INTEGER :: iyea0        ! Initial date 
    7967      INTEGER :: imon0        !  - (year, month, day, hour, minute) 
    … …  
    9482      INTEGER :: inlasobsmpp    !  - close to land 
    9583      INTEGER :: igrdobsmpp     !  - fail the grid search 
    96       LOGICAL, DIMENSION(:), ALLOCATABLE :: &  
    97          & llvalid            ! SLA data selection 
     84      LOGICAL, DIMENSION(:), ALLOCATABLE ::   llvalid            ! SLA data selection 
    9885      INTEGER :: jobs         ! Obs. loop variable 
    9986      INTEGER :: jstp         ! Time loop variable 
    10087      INTEGER :: inrc         ! Time index variable 
    101  
    102       IF(lwp) WRITE(numout,*)'obs_pre_surf : Preparing the surface observations...' 
    103       IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     88      !!---------------------------------------------------------------------- 
     89 
     90      IF(lwp) WRITE(numout,*) 'obs_pre_surf : Preparing the surface observations...' 
     91      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    10492       
    10593      ! Initial date initialization (year, month, day, hour, minute) 
    … …  
    253241      !! 
    254242      !!---------------------------------------------------------------------- 
    255       !! * Modules used 
    256       USE domstp              ! Domain: set the time-step 
    257       USE par_oce             ! Ocean parameters 
    258       USE dom_oce, ONLY : &   ! Geographical information 
    259          & gdept_1d,             & 
    260          & nproc 
     243      USE par_oce           ! Ocean parameters 
     244      USE dom_oce, ONLY :   gdept_1d, nproc   ! Geographical information 
    261245 
    262246      !! * Arguments 
    … …  
    314298      INTEGER :: jstp         ! Time loop variable 
    315299      INTEGER :: inrc         ! Time index variable 
     300      !!---------------------------------------------------------------------- 
    316301 
    317302      IF(lwp) WRITE(numout,*)'obs_pre_prof: Preparing the profile data...' 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r6595 r6717  
    4343   USE sbcisf         ! surface boundary condition: ice shelf 
    4444   USE sbcfwb         ! surface boundary condition: freshwater budget 
    45    USE closea         ! closed sea 
    4645   USE icbstp         ! Icebergs 
    4746   USE traqsr         ! active tracers: light penetration 
    4847   USE sbcwave        ! Wave module 
    4948   USE bdy_par        ! Require lk_bdy 
     49   USE usrdef_closea  ! closed sea 
    5050   ! 
    5151   USE prtctl         ! Print control                    (prt_ctl routine) 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r6140 r6717  
    2020   USE sbc_oce        ! surface boundary condition variables 
    2121   USE sbcisf         ! PM we could remove it I think 
    22    USE closea         ! closed seas 
    2322   USE eosbn2         ! Equation Of State 
     23   USE usrdef_closea  ! closed seas 
    2424   ! 
    2525   USE in_out_manager ! I/O manager 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90

    r6140 r6717  
    581581            ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) = 10.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    582582            ! 
    583          CASE ( 4 )                          ! ORCA_R4 
    584             ij0 =  52   ;   ij1 =  52              ! Gibraltar enhancement of BBL 
    585             ii0 =  70   ;   ii1 =  71 
    586             ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahu_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    587             ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) =  4.e0*ahv_bbl_0(mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1)) 
    588583         END SELECT 
    589584         ! 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_closea.F90

    r6594 r6717  
    1 MODULE closea 
     1MODULE usrdef_closea 
    22   !!====================================================================== 
    3    !!                       ***  MODULE  closea  *** 
    4    !! Closed Seas : specific treatments associated with closed seas 
     3   !!                   ***  MODULE  usrdef_closea  *** 
     4   !! User define : specific treatments associated with closed seas 
    55   !!====================================================================== 
    6    !! History :   8.2  !  00-05  (O. Marti)  Original code 
    7    !!             8.5  !  02-06  (E. Durand, G. Madec)  F90 
    8    !!             9.0  !  06-07  (G. Madec)  add clo_rnf, clo_ups, clo_bat 
    9    !!        NEMO 3.4  !  03-12  (P.G. Fogli) sbc_clo bug fix & mpp reproducibility 
     6   !! History :   8.2  !  2000-05  (O. Marti)  Original code 
     7   !!   NEMO      1.0  !  2002-06  (E. Durand, G. Madec)  F90 
     8   !!             3.0  !  2006-07  (G. Madec)  add clo_rnf, clo_ups, clo_bat 
     9   !!             3.4  !  2014-12  (P.G. Fogli) sbc_clo bug fix & mpp reproducibility 
     10   !!             4.0  !  2016-06  (G. Madec)  move to usrdef_closea, remove clo_ups 
    1011   !!---------------------------------------------------------------------- 
    1112 
    … …  
    1415   !!   sbc_clo    : Special handling of closed seas 
    1516   !!   clo_rnf    : set close sea outflows as river mouths (see sbcrnf) 
    16    !!   clo_ups    : set mixed centered/upstream scheme in closed sea (see traadv_cen2) 
    1717   !!   clo_bat    : set to zero a field over closed sea (see domzrg) 
    1818   !!---------------------------------------------------------------------- 
    … …  
    2020   USE dom_oce         ! ocean space and time domain 
    2121   USE phycst          ! physical constants 
     22   USE sbc_oce         ! ocean surface boundary conditions 
     23   ! 
    2224   USE in_out_manager  ! I/O manager 
    23    USE sbc_oce         ! ocean surface boundary conditions 
    2425   USE lib_fortran,    ONLY: glob_sum, DDPDD 
    2526   USE lbclnk          ! lateral boundary condition - MPP exchanges 
    … …  
    3334   PUBLIC sbc_clo      ! routine called by step module 
    3435   PUBLIC clo_rnf      ! routine called by sbcrnf module 
    35    PUBLIC clo_ups      ! routine called in traadv_cen2(_jki) module 
    3636   PUBLIC clo_bat      ! routine called in domzgr module 
    3737 
    … …  
    4848#  include "vectopt_loop_substitute.h90" 
    4949   !!---------------------------------------------------------------------- 
    50    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     50   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    5151   !! $Id$ 
    5252   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5454CONTAINS 
    5555 
    56    SUBROUTINE dom_clo 
     56   SUBROUTINE dom_clo( cd_cfg, kcfg ) 
    5757      !!--------------------------------------------------------------------- 
    5858      !!                  ***  ROUTINE dom_clo  *** 
    … …  
    7171      !!                                   =2 put at location runoff 
    7272      !!---------------------------------------------------------------------- 
     73      CHARACTER(len=1)          , INTENT(in   ) ::   cd_cfg   ! configuration name 
     74      INTEGER                   , INTENT(in   ) ::   kcfg     ! configuration identifier  
     75      ! 
    7376      INTEGER ::   jc      ! dummy loop indices 
    7477      INTEGER ::   isrow   ! local index 
    … …  
    8689      ! ------------------- 
    8790      ! 
    88       IF( cp_cfg == "orca" ) THEN 
    89          ! 
    90          SELECT CASE ( jp_cfg ) 
     91      IF( cd_cfg == "orca" ) THEN      !==  ORCA configuration  ==! 
     92         ! 
     93         SELECT CASE ( kcfg ) 
    9194         !                                           ! ======================= 
    92          CASE ( 1 )                                  ! ORCA_R1 configuration 
     95         CASE ( 1 )                                  !  ORCA_R1 configuration 
    9396            !                                        ! ======================= 
     97            IF(lwp) WRITE(numout,*)'   ORCA_R1 closed seas :  only the Caspian Sea' 
    9498            ! This dirty section will be suppressed by simplification process: 
    9599            ! all this will come back in input files 
    … …  
    98102            isrow = 332 - jpjglo 
    99103            ! 
    100             ncsnr(1)   = 1    ; ncstt(1)   = 0           ! Caspian Sea 
     104            ncsnr(1)   = 1    ; ncstt(1)   = 0           ! Caspian Sea  (spread over the globe) 
    101105            ncsi1(1)   = 332  ; ncsj1(1)   = 243 - isrow 
    102106            ncsi2(1)   = 344  ; ncsj2(1)   = 275 - isrow 
    … …  
    106110         CASE ( 2 )                                  !  ORCA_R2 configuration 
    107111            !                                        ! ======================= 
     112            IF(lwp) WRITE(numout,*)'   ORCA_R2 closed seas and lakes : ' 
    108113            !                                            ! Caspian Sea 
     114            IF(lwp) WRITE(numout,*)'      Caspian Sea  ' 
    109115            ncsnr(1)   =   1  ;  ncstt(1)   =   0           ! spread over the globe 
    110116            ncsi1(1)   =  11  ;  ncsj1(1)   = 103 
    … …  
    112118            ncsir(1,1) =   1  ;  ncsjr(1,1) =   1  
    113119            !                                            ! Great North American Lakes 
     120            IF(lwp) WRITE(numout,*)'      Great North American Lakes  ' 
    114121            ncsnr(2)   =   1  ;  ncstt(2)   =   2           ! put at St Laurent mouth 
    115122            ncsi1(2)   =  97  ;  ncsj1(2)   = 107 
    … …  
    117124            ncsir(2,1) = 110  ;  ncsjr(2,1) = 111            
    118125            !                                            ! Black Sea (crossed by the cyclic boundary condition) 
     126            IF(lwp) WRITE(numout,*)'      Black Sea  ' 
    119127            ncsnr(3:4) =   4  ;  ncstt(3:4) =   2           ! put in Med Sea (north of Aegean Sea) 
    120128            ncsir(3:4,1) = 171;  ncsjr(3:4,1) = 106         ! 
    … …  
    126134            ncsi1(4)   =   2  ;  ncsj1(4)   = 107           ! 2 : east part of the Black Sea  
    127135            ncsi2(4)   =   6  ;  ncsj2(4)   = 112           !           (ie east of the cyclic b.c.) 
    128               
    129            
    130  
    131             !                                        ! ======================= 
    132          CASE ( 4 )                                  !  ORCA_R4 configuration 
    133             !                                        ! ======================= 
     136            ! 
     137            !                                        ! ========================= 
     138         CASE ( 025 )                                !  ORCA_R025 configuration 
     139            !                                        ! ========================= 
     140            IF(lwp) WRITE(numout,*)'   ORCA_R025 closed seas : ' 
    134141            !                                            ! Caspian Sea 
    135             ncsnr(1)   =  1  ;  ncstt(1)   =  0   
    136             ncsi1(1)   =  4  ;  ncsj1(1)   = 53  
    137             ncsi2(1)   =  4  ;  ncsj2(1)   = 56 
    138             ncsir(1,1) =  1  ;  ncsjr(1,1) =  1 
    139             !                                            ! Great North American Lakes 
    140             ncsnr(2)   =  1  ;  ncstt(2)   =  2  
    141             ncsi1(2)   = 49  ;  ncsj1(2)   = 55 
    142             ncsi2(2)   = 51  ;  ncsj2(2)   = 56 
    143             ncsir(2,1) = 57  ;  ncsjr(2,1) = 55 
    144             !                                            ! Black Sea 
    145             ncsnr(3)   =  4  ;  ncstt(3)   =  2   
    146             ncsi1(3)   = 88  ;  ncsj1(3)   = 55  
    147             ncsi2(3)   = 91  ;  ncsj2(3)   = 56 
    148             ncsir(3,1) = 86  ;  ncsjr(3,1) = 53 
    149             ncsir(3,2) = 87  ;  ncsjr(3,2) = 53  
    150             ncsir(3,3) = 86  ;  ncsjr(3,3) = 52  
    151             ncsir(3,4) = 87  ;  ncsjr(3,4) = 52 
    152             !                                            ! Baltic Sea 
    153             ncsnr(4)   =  1  ;  ncstt(4)   =  2 
    154             ncsi1(4)   = 75  ;  ncsj1(4)   = 59 
    155             ncsi2(4)   = 76  ;  ncsj2(4)   = 61 
    156             ncsir(4,1) = 84  ;  ncsjr(4,1) = 59  
    157             !                                        ! ======================= 
    158          CASE ( 025 )                                ! ORCA_R025 configuration 
    159             !                                        ! ======================= 
     142            IF(lwp) WRITE(numout,*)'      Caspian Sea  ' 
    160143            ncsnr(1)   = 1    ; ncstt(1)   = 0               ! Caspian + Aral sea 
    161144            ncsi1(1)   = 1330 ; ncsj1(1)   = 645 
    … …  
    163146            ncsir(1,1) = 1    ; ncsjr(1,1) = 1 
    164147            !                                         
     148            IF(lwp) WRITE(numout,*)'      Azov Sea  ' 
    165149            ncsnr(2)   = 1    ; ncstt(2)   = 0               ! Azov Sea  
    166150            ncsi1(2)   = 1284 ; ncsj1(2)   = 722 
    … …  
    169153            ! 
    170154         END SELECT 
     155         ! 
     156      ELSE                             !==  No closed sea in the configuration  ==! 
     157         ! 
     158         IF(lwp) WRITE(numout,*)'   No closed seas or lakes in the configuration ' 
    171159         ! 
    172160      ENDIF 
    … …  
    177165         ncsi1(jc)   = mi0( ncsi1(jc) ) 
    178166         ncsj1(jc)   = mj0( ncsj1(jc) ) 
    179  
     167         ! 
    180168         ncsi2(jc)   = mi1( ncsi2(jc) )    
    181169         ncsj2(jc)   = mj1( ncsj2(jc) )   
    … …  
    215203         IF(lwp) WRITE(numout,*)'~~~~~~~' 
    216204 
    217          surf(:) = 0.e0_wp 
     205         surf(:) = 0._wp 
    218206         ! 
    219207         surf(jpncs+1) = glob_sum( e1e2t(:,:) )   ! surface of the global ocean 
    … …  
    398386      ! 
    399387   END SUBROUTINE clo_rnf 
    400  
    401     
    402    SUBROUTINE clo_ups( p_upsmsk ) 
    403       !!--------------------------------------------------------------------- 
    404       !!                  ***  ROUTINE sbc_rnf  *** 
    405       !!                     
    406       !! ** Purpose :   allow the treatment of closed sea outflow grid-points 
    407       !!                to be the same as river mouth grid-points 
    408       !! 
    409       !! ** Method  :   set to 0.5 the upstream mask (upsmsk, see traadv_cen2  
    410       !!                module) over the closed seas. 
    411       !! 
    412       !! ** Action  :   update (p_)upsmsk (set 0.5 over closed seas) 
    413       !!---------------------------------------------------------------------- 
    414       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   p_upsmsk   ! upstream mask (upsmsk array) 
    415       ! 
    416       INTEGER  ::   jc, ji, jj      ! dummy loop indices 
    417       !!---------------------------------------------------------------------- 
    418       ! 
    419       DO jc = 1, jpncs 
    420          DO jj = ncsj1(jc), ncsj2(jc) 
    421             DO ji = ncsi1(jc), ncsi2(jc) 
    422                p_upsmsk(ji,jj) = 0.5_wp         ! mixed upstream/centered scheme over closed seas 
    423             END DO  
    424          END DO  
    425        END DO  
    426        ! 
    427    END SUBROUTINE clo_ups 
    428388    
    429389       
    430    SUBROUTINE clo_bat( pbat, kbat ) 
     390   SUBROUTINE clo_bat( k_top, k_bot ) 
    431391      !!--------------------------------------------------------------------- 
    432392      !!                  ***  ROUTINE clo_bat  *** 
    … …  
    434394      !! ** Purpose :   suppress closed sea from the domain 
    435395      !! 
    436       !! ** Method  :   set to 0 the meter and level bathymetry (given in  
    437       !!                arguments) over the closed seas. 
     396      !! ** Method  :   set first and last ocean level to 0 over the closed seas. 
    438397      !! 
    439398      !! ** Action  :   set pbat=0 and kbat=0 over closed seas 
    440399      !!---------------------------------------------------------------------- 
    441       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pbat   ! bathymetry in meters (bathy array) 
    442       INTEGER , DIMENSION(jpi,jpj), INTENT(inout) ::   kbat   ! bathymetry in levels (mbathy array) 
     400      INTEGER, DIMENSION(:,:), INTENT(inout) ::   k_top, k_bot   ! ocean first and last level indices 
    443401      ! 
    444402      INTEGER  ::   jc, ji, jj      ! dummy loop indices 
    … …  
    448406         DO jj = ncsj1(jc), ncsj2(jc) 
    449407            DO ji = ncsi1(jc), ncsi2(jc) 
    450                pbat(ji,jj) = 0._wp    
    451                kbat(ji,jj) = 0    
     408               k_top(ji,jj) = 0    
     409               k_bot(ji,jj) = 0    
    452410            END DO  
    453411         END DO  
    … …  
    457415 
    458416   !!====================================================================== 
    459 END MODULE closea 
    460  
     417END MODULE usrdef_closea 
     418 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_sbc.F90

    r6595 r6717  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  usrdef_sbc  *** 
    4    !! Ocean forcing:  analytical momentum, heat and freshwater forcings 
     4   !! Ocean forcing:  user defined momentum, heat and freshwater forcings 
     5   !! 
     6   !!                ===     Here  GYRE configuration      === 
     7   !! 
    58   !!===================================================================== 
    6    !! History :  3.0   ! 2006-06  (G. Madec)  Original code 
    7    !!            3.2   ! 2009-07  (G. Madec)  Style only 
    8    !!---------------------------------------------------------------------- 
    9  
    10    !!---------------------------------------------------------------------- 
    11    !!   usr_def_sbc    : user defined surface bounday conditions 
     9   !! History :  4.0   ! 2016-03  (S. Flavoni, G. Madec)  user defined interface 
     10   !!---------------------------------------------------------------------- 
     11 
     12   !!---------------------------------------------------------------------- 
     13   !!   usr_def_sbc    : user defined surface bounday conditions in GYRE case 
    1214   !!---------------------------------------------------------------------- 
    1315   USE oce             ! ocean dynamics and tracers 
    … …  
    2931#  include "vectopt_loop_substitute.h90" 
    3032   !!---------------------------------------------------------------------- 
    31    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    32    !! $Id:$ 
     33   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
     34   !! $Id: $ 
    3335   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3436   !!---------------------------------------------------------------------- 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_zgr.F90

    r6667 r6717  
    1818   USE oce               ! ocean variables 
    1919   USE dom_oce           ! ocean domain 
    20    USE dommsk            ! domain: set the mask system 
    21    USE wet_dry           ! wetting and drying 
    22    USE closea            ! closed seas 
    23    USE c1d               ! 1D vertical configuration 
    2420   ! 
    2521   USE in_out_manager    ! I/O manager 
    26    USE iom               ! I/O library 
    2722   USE lbclnk            ! ocean lateral boundary conditions (or mpp link) 
    2823   USE lib_mpp           ! distributed memory computing library 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r6667 r6717  
    9393   USE dia25h         ! 25h mean output 
    9494   USE wet_dry        ! Wetting and drying setting   (wad_init routine) 
    95    USE usrdef         ! user defined configuration 
     95   USE usrdef_nam     ! user defined configuration 
    9696 
    9797   IMPLICIT NONE 
    … …  
    105105 
    106106   !!---------------------------------------------------------------------- 
    107    !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
     107   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    108108   !! $Id$ 
    109109   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    300300      ENDIF 
    301301      jpk    = jpkglo 
    302       jpidta = jpiglo         !!gm  jpidta, jpjdta : to be suppressed 
    303       jpjdta = jpjglo         !!gm    
    304       jpkdta = jpkglo 
    305302      ! 
    306303#if defined key_agrif 
    … …  
    310307         jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
    311308         jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
    312          jpidta  = jpiglo 
    313          jpjdta  = jpjglo 
    314309         nperio  = 0 
    315310         jperio  = 0 
    … …  
    387382#endif 
    388383      ENDIF 
    389                 
    390       jpk = jpkdta                                             ! third dim 
    391        
     384 
     385!!gm ???    why here  it has already been done in line 301 ! 
     386      jpk = jpkglo                                             ! third dim 
     387!!gm end 
     388 
    392389#if defined key_agrif 
    393390      ! simple trick to use same vertical grid as parent but different number of levels:  
    394       ! Save maximum number of levels in jpkdta, then define all vertical grids with this number. 
     391      ! Save maximum number of levels in jpkglo, then define all vertical grids with this number. 
    395392      ! Suppress once vertical online interpolation is ok 
    396       IF(.NOT.Agrif_Root())   jpkdta = Agrif_Parent( jpkdta ) 
     393      IF(.NOT.Agrif_Root())   jpkglo = Agrif_Parent( jpkglo ) 
    397394#endif 
    398395      jpim1 = jpi-1                                            ! inner domain indices 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/par_oce.F90

    r6667 r6717  
    3131   !! Domain Matrix size  
    3232   !!--------------------------------------------------------------------- 
    33  
    34 !!gm  TO BE SUPRESSED 
    35    ! data size                        !!! * size of all input files * 
    36    INTEGER       ::   jpidta           !: 1st lateral dimension  
    37    INTEGER       ::   jpjdta           !: 2nd    "         "    
    38    INTEGER       ::   jpkdta           !: number of levels      
    39 !!gm  END 
    4033 
    4134   ! global domain size               !!! * total computational domain * 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/step.F90

    r6381 r6717  
    237237      IF( nn_diacfl == 1 )   CALL dia_cfl( kstp )         ! Courant number diagnostics 
    238238      IF( lk_diahth  )   CALL dia_hth( kstp )         ! Thermocline depth (20 degres isotherm depth) 
    239       IF(.NOT.ln_cpl )   CALL dia_fwb( kstp )         ! Fresh water budget diagnostics 
    240239      IF( lk_diadct  )   CALL dia_dct( kstp )         ! Transports 
    241240      IF( lk_diaar5  )   CALL dia_ar5( kstp )         ! ar5 diag 

  • branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/step_oce.F90

    r6140 r6717  
    8484   USE diaar5           ! AR5 diagnosics                   (dia_ar5 routine) 
    8585   USE diahth           ! thermocline depth                (dia_hth routine) 
    86    USE diafwb           ! freshwater budget                (dia_fwb routine) 
    8786   USE diahsb           ! heat, salt and volume budgets    (dia_hsb routine) 
    8887   USE diaharm 
Note: See TracChangeset for help on using the changeset viewer.