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 11604 for NEMO/branches/2019 – NEMO

Changeset 11604 for NEMO/branches/2019


Ignore:
Timestamp:
2019-09-26T18:48:45+02:00 (5 years ago)
Author:
mathiot
Message:

ENHANCE-03_domcfg: remove useless variable in domclo and domutil + cosmetics changes (ticket #2143)

Location:
NEMO/branches/2019/ENHANCE-03_domcfg/src
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/ENHANCE-03_domcfg/src/dom_oce.F90

    r11602 r11604  
    239239   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask                        !: land/ocean mask at W- pts                
    240240 
    241    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_opnsea, msk_closea                 !: open ocean mask, closed sea mask (all of them) 
    242    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_glo  , msk_rnf  , msk_emp                !: closed sea masks 
    243    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_gloid, msk_rnfid, msk_empid              !: closed sea masks 
     241   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_opnsea, msk_closea                 !: open ocean mask, closed sea mask (all of them) 
     242   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_glo  , msk_rnf  , msk_emp                !: closed sea masks 
     243   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_gloid, msk_rnfid, msk_empid              !: closed sea masks 
    244244 
    245245   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4) 

  • NEMO/branches/2019/ENHANCE-03_domcfg/src/domain.F90

    r11201 r11604  
    6161      !!              - 1D configuration, move Coriolis, u and v at T-point 
    6262      !!---------------------------------------------------------------------- 
    63       INTEGER ::   jk          ! dummy loop indices 
    64       INTEGER ::   iconf = 0   ! local integers 
    65       REAL(wp), POINTER, DIMENSION(:,:) ::   z1_hu_0, z1_hv_0 
    66       !!---------------------------------------------------------------------- 
    6763      ! 
    6864      IF(lwp) THEN 
    … …  
    8076      CALL dom_zgr                  ! Vertical mesh and bathymetry 
    8177      ! 
    82       IF ( ln_domclo .OR. nmsh > 0 ) CALL dom_msk                  ! compute mask (needed by dom_clo 
     78      IF ( ln_domclo .OR. nn_msh > 0 ) CALL dom_msk ! compute mask (needed by dom_clo) 
    8379      ! 
    8480      IF ( ln_domclo ) CALL dom_clo ! Closed seas and lake 
    … …  
    420416      IF (ln_domclo) THEN 
    421417         ! mask for the open sea 
    422          CALL iom_rstput( 0, 0, inum, 'mask_opensea', msk_opnsea, ktype = jp_i4 ) 
     418         CALL iom_rstput( 0, 0, inum, 'mask_opensea' , msk_opnsea, ktype = jp_i4 ) 
    423419         ! mask for all the under closed sea 
    424          CALL iom_rstput( 0, 0, inum, 'mask_csundef', msk_closea, ktype = jp_i4 ) 
     420         CALL iom_rstput( 0, 0, inum, 'mask_csundef' , msk_closea, ktype = jp_i4 ) 
    425421         ! mask for global, local net precip, local net precip and evaporation correction 
    426          CALL iom_rstput( 0, 0, inum, 'mask_csglo', msk_glo, ktype = jp_i4 ) 
    427          CALL iom_rstput( 0, 0, inum, 'mask_csemp', msk_emp, ktype = jp_i4 ) 
    428          CALL iom_rstput( 0, 0, inum, 'mask_csrnf', msk_rnf, ktype = jp_i4 ) 
     422         CALL iom_rstput( 0, 0, inum, 'mask_csglo'   , msk_glo   , ktype = jp_i4 ) 
     423         CALL iom_rstput( 0, 0, inum, 'mask_csemp'   , msk_emp   , ktype = jp_i4 ) 
     424         CALL iom_rstput( 0, 0, inum, 'mask_csrnf'   , msk_rnf   , ktype = jp_i4 ) 
    429425         ! mask for the various river mouth (in case multiple lake in the same outlet) 
    430          CALL iom_rstput( 0, 0, inum, 'mask_csgrpglo', msk_gloid, ktype = jp_i4 ) 
    431          CALL iom_rstput( 0, 0, inum, 'mask_csgrpemp', msk_empid, ktype = jp_i4 ) 
    432          CALL iom_rstput( 0, 0, inum, 'mask_csgrprnf', msk_rnfid, ktype = jp_i4 ) 
     426         CALL iom_rstput( 0, 0, inum, 'mask_csgrpglo', msk_gloid , ktype = jp_i4 ) 
     427         CALL iom_rstput( 0, 0, inum, 'mask_csgrpemp', msk_empid , ktype = jp_i4 ) 
     428         CALL iom_rstput( 0, 0, inum, 'mask_csgrprnf', msk_rnfid , ktype = jp_i4 ) 
    433429      END IF 
    434430      ! 

  • NEMO/branches/2019/ENHANCE-03_domcfg/src/domclo.F90

    r11201 r11604  
    5858         CHARACTER(256) :: cloctrg                     ! where water is spread 
    5959         CHARACTER(256) :: cschtrg                     ! how   water is spread 
    60          REAL(wp)       :: radtrg                      ! radius of closed sea river mouth 
     60         REAL(wp)       :: radtrg                      ! radius of closed sea river mouth (used if cschtrg is rnf or emp) 
    6161         INTEGER        :: idtrg                       ! target id in case multiple lakes for the same river mouth 
    6262      END TYPE 
    … …  
    7070      INTEGER :: nn_closea          ! number of closed seas 
    7171 
    72       REAL(wp) :: zdistseed         ! distance to seed 
    73       REAL(wp) :: zarea             ! river mouth area 
    74       REAL(wp) :: rn_lon_opnsea, rn_lat_opnsea ! open sea seed 
    75       REAL(wp), DIMENSION(1)       :: zchk, zradtrg 
    76       REAL(wp), DIMENSION(jpi,jpj) :: zmsksrc, zmsktrg, zmsk_coastline, zdist 
    77  
    78       CHARACTER(256) :: csch, cloc        ! scheme name for water spreading (glo, rnf, emp) 
    79       TYPE(closea)  , DIMENSION(jp_closea)   :: sn_lake   ! lake properties 
     72      REAL(wp) :: zdistseed                         ! distance to seed 
     73      REAL(wp) :: zarea                             ! river mouth area 
     74      REAL(wp) :: rn_lon_opnsea, rn_lat_opnsea      ! open sea seed 
     75      REAL(wp), DIMENSION(1)       :: zchk, zradtrg ! 
     76      REAL(wp), DIMENSION(jpi,jpj) :: zdist         ! distance to seed trg location 
     77      REAL(wp), DIMENSION(jpi,jpj) :: zmsksrc, zmsktrg, zmsk_coastline ! various mask 
     78 
     79      CHARACTER(256) :: csch, cloc                       ! scheme name for water spreading (glo, rnf, emp) 
     80      TYPE(closea)  , DIMENSION(jp_closea)   :: sn_lake  ! lake properties 
    8081 
    8182      LOGICAL :: lskip     ! flag in case lake seed on land or already filled (...) 
    … …  
    9091      NAMELIST/namclo/ rn_lon_opnsea, rn_lat_opnsea, nn_closea, sn_lake 
    9192      !!--------------------------------------------------------------------- 
    92       PRINT *, rn_lon_opnsea, rn_lat_opnsea, nn_closea 
    93       !! 
     93       
    9494      REWIND( numnam_ref )              ! Namelist namlbc in reference namelist : Lateral momentum boundary condition 
    9595      READ  ( numnam_ref, namclo, IOSTAT = ios, ERR = 901 ) 
    … …  
    118118      IF (zchk(1) == 0._wp) CALL ctl_stop( 'STOP', 'open sea seed is on land, please update namelist (rn_lon_opnsea,rn_lat_opnsea)' )  
    119119 
    120       !! 1.3 set to 0 everything >0 and revert mask 
     120      !! print 
    121121      IF (lwp) THEN 
    122122         WRITE(numout,*) 
    … …  
    128128      END IF 
    129129       
    130       WHERE (msk_opnsea(:,:) > 0) msk_opnsea(:,:) = 0 ! mask all closed seas 
    131       WHERE (msk_opnsea(:,:) < 0) msk_opnsea(:,:) = 1 ! restore mask value 
     130      !! 1.3 set to 0 everything >0 and revert mask 
     131      WHERE (msk_opnsea(:,:) > 0._wp) msk_opnsea(:,:) = 0._wp ! mask all closed seas 
     132      WHERE (msk_opnsea(:,:) < 0._wp) msk_opnsea(:,:) = 1._wp ! restore mask value 
    132133 
    133134      !! 1.4 Define closed sea mask (all of them, ie defined in the namelist or not) 
    134135      !! needed to remove the undefined closed seas at the end 
    135       msk_closea = (ssmask - msk_opnsea) * 99 
     136      msk_closea(:,:) = ( ssmask(:,:) - msk_opnsea(:,:) ) * 99._wp 
    136137 
    137138      !!---------------------------------------------------------------------- 
    … …  
    142143      jglo = 1 ; jrnf = 1 ; jemp = 1 
    143144      !! mask used to group lake by net evap/precip distribution technics 
    144       msk_glo = msk_closea 
    145       msk_rnf = msk_closea 
    146       msk_emp = msk_closea 
     145      msk_glo(:,:) = msk_closea(:,:) 
     146      msk_rnf(:,:) = msk_closea(:,:) 
     147      msk_emp(:,:) = msk_closea(:,:) 
    147148 
    148149      !! mask used to group multiple lake with the same river mouth (great lake for example) 
    149       msk_gloid = 0.0_wp 
    150       msk_rnfid = 0.0_wp 
    151       msk_empid = 0.0_wp 
     150      msk_gloid(:,:) = 0.0_wp 
     151      msk_rnfid(:,:) = 0.0_wp 
     152      msk_empid(:,:) = 0.0_wp 
    152153 
    153154      IF (lwp) WRITE(numout,*)'closed seas: ' 
    … …  
    175176         CASE('glo') 
    176177            jsch = jglo 
    177             zmsksrc = msk_glo 
    178             zmsktrg = msk_gloid 
     178            zmsksrc(:,:) = msk_glo(:,:) 
     179            zmsktrg(:,:) = msk_gloid(:,:) 
    179180            IF (lwp) WRITE(numout,*)'        net evap/precip will be spread globally' 
    180181         CASE('rnf')  
    181182            jsch = jrnf 
    182             zmsksrc = msk_rnf 
    183             zmsktrg = msk_rnfid 
     183            zmsksrc(:,:) = msk_rnf(:,:) 
     184            zmsktrg(:,:) = msk_rnfid(:,:) 
    184185            IF (lwp) WRITE(numout,*)'        net precip will be spread locally and net evap globally' 
    185186         CASE('emp') 
    186187            jsch = jemp  
    187             zmsksrc = msk_emp 
    188             zmsktrg = msk_empid 
     188            zmsksrc(:,:) = msk_emp(:,:) 
     189            zmsktrg(:,:) = msk_empid(:,:) 
    189190            IF (lwp) WRITE(numout,*)'        net precip will be spread locally' 
    190191         CASE DEFAULT 
    … …  
    213214            !! fill close sea mask with counter value 
    214215            CALL fill_pool( jiseed, jjseed, zmsksrc, REAL(jsch  ,8)) 
    215             WHERE (zmsksrc == REAL(jsch,8)) 
     216            WHERE (zmsksrc(:,:) == REAL(jsch,8)) 
    216217               msk_closea = 0._wp 
    217218               zmsktrg    = sn_lake(jcs)%idtrg 
    … …  
    220221            !! compute location of river mouth and distance to river mouth 
    221222            IF (cloc /= 'global') THEN 
     223 
    222224               !! set a minimum value for radius of the river influence 
    223225               zradtrg = 0._wp 
    … …  
    229231               !! compute seed location for print  
    230232               CALL dom_ngb(sn_lake(jcs)%rlontrg, sn_lake(jcs)%rlattrg, jiseed, jjseed, zdistseed, 'T') 
     233 
    231234               !! compute distance to river mouth 
    232235               zdist(:,:) = dist(sn_lake(jcs)%rlontrg, sn_lake(jcs)%rlattrg, glamt, gphit) 
     236 
    233237            END IF 
    234238 
    … …  
    237241            SELECT CASE (cloc) 
    238242            CASE ('global') 
    239                WHERE (msk_opnsea(:,:) == 1) zmsktrg = sn_lake(jcs)%idtrg 
     243               WHERE (msk_opnsea(:,:) == 1._wp) zmsktrg = sn_lake(jcs)%idtrg 
    240244 
    241245            CASE ('local') 
    242246               !! compute mask 
    243247               WHERE (zdist(:,:) < zradtrg(1) .AND. msk_opnsea(:,:) == 1 ) zmsktrg = sn_lake(jcs)%idtrg 
     248 
    244249               !! print 
    245250               IF (lwp) WRITE(numout,'(a,f7.0,a,2f7.2,a,2i7,a)')'         river mouth area is defined by         points within ',zradtrg(1)         & 
    246251                             &        ,' m of lat/lon ', sn_lake(jcs)%rlontrg, sn_lake(jcs)%rlattrg                                  & 
    247252                             &        ,' (closest point is i/j ',jiseed, jjseed,')' 
    248    
    249253            CASE ('coast') 
    250254               !! define coastline mask 
    … …  
    259263               !! compute mask 
    260264               WHERE ( zdist(:,:) < zradtrg(1) .AND. zmsk_coastline(:,:) == 1 .AND. msk_opnsea(:,:) == 1 ) zmsktrg = sn_lake(jcs)%idtrg 
     265 
    261266               !! print 
    262267               IF (lwp) WRITE(numout,'(a,f7.0,a,2f7.2,a,2i7,a)')'         river mouth area is defined by coastal points within ',zradtrg(1) & 
    … …  
    277282            CASE ('glo') 
    278283               jglo = jglo + 1 
    279                msk_glo   = zmsksrc 
    280                msk_gloid = zmsktrg 
     284               msk_glo(:,:)   = zmsksrc(:,:) 
     285               msk_gloid(:,:) = zmsktrg(:,:) 
    281286            CASE ('rnf') 
    282287               jrnf = jrnf + 1 
    283                msk_rnf   = zmsksrc 
    284                msk_rnfid = zmsktrg 
     288               msk_rnf(:,:)   = zmsksrc(:,:) 
     289               msk_rnfid(:,:) = zmsktrg(:,:) 
    285290            CASE ('emp') 
    286291               jemp = jemp + 1 
    287                msk_emp   = zmsksrc 
    288                msk_empid = zmsktrg 
     292               msk_emp(:,:)   = zmsksrc(:,:) 
     293               msk_empid(:,:) = zmsktrg(:,:) 
    289294            END SELECT 
    290295 
    … …  
    298303 
    299304      !! mask all the cells not defined as closed sea 
    300       WHERE ( msk_glo == 99 ) msk_glo = 0 
    301       WHERE ( msk_rnf == 99 ) msk_rnf = 0 
    302       WHERE ( msk_emp == 99 ) msk_emp = 0 
     305      WHERE ( msk_glo(:,:) == 99._wp )  msk_glo = 0._wp 
     306      WHERE ( msk_rnf(:,:) == 99._wp )  msk_rnf = 0._wp 
     307      WHERE ( msk_emp(:,:) == 99._wp )  msk_emp = 0._wp 
    303308 
    304309      !!  non defined closed sea 
    305       WHERE (msk_closea > 0) msk_closea = 1 
     310      WHERE ( msk_closea(:,:) > 0._wp ) msk_closea = 1._wp 
    306311 
    307312   END SUBROUTINE dom_clo 

  • NEMO/branches/2019/ENHANCE-03_domcfg/src/domutl.F90

    r11201 r11604  
    4545      !! 
    4646      !!---------------------------------------------------------------------- 
    47       INTEGER,                          INTENT(in)    :: kiseed, kjseed, kkseed 
    48       REAL(wp),                         INTENT(in)    :: rfill    ! filling value 
    49       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: rdta     ! input data 
    50       REAL(wp), DIMENSION(jpi,jpj,jpk)                :: rseedmap, rseedmap_b  ! 
    51   
    52       INTEGER :: ip=0                 ! size of the pile 
     47      INTEGER,                          INTENT(in)    :: kiseed, kjseed, kkseed ! seed 
     48      REAL(wp),                         INTENT(in)    :: rfill                  ! filling value 
     49      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: rdta                   ! input data 
     50      REAL(wp), DIMENSION(jpi,jpj,jpk)                :: rseedmap, rseedmap_b   ! map of seed (use for processor communication) 
     51  
    5352      INTEGER :: ii  , ij  , ik   , kii, kjj, jj, kk    ! working integer 
    54       INTEGER :: iip1, ijp1, ikp1 
    55       INTEGER :: iim1, ijm1, ikm1 
    56       INTEGER :: nseed 
     53      INTEGER :: iip1, ijp1, ikp1                       ! working integer 
     54      INTEGER :: iim1, ijm1, ikm1                       ! working integer 
     55      INTEGER :: nseed                                  ! size of the stack 
    5756      TYPE (idx), POINTER :: seed 
    5857      !!----------------------------------------------------------------------  
    … …  
    7574      nseed=SUM(rseedmap); IF( lk_mpp )   CALL mpp_sum('domutil', nseed )  ! nseed =0 means on land => WARNING later on 
    7675      ! 
    77       ! loop until the pile size is 0 or if the pool is larger than the critical size 
     76      ! loop until the stack size is 0 or if the pool is larger than the critical size 
    7877      IF (nseed > 0) THEN 
    7978         ! seed on ocean continue 
    8079         DO WHILE ( nseed /= 0 ) 
    8180            DO WHILE ( ASSOCIATED(seed) ) 
    82                ip=ip+1 
    8381               ii=seed%i; ij=seed%j ; ik=seed%k ; rseedmap(ii,ij,ik)=1. 
    8482               !  
    85                ! update bathy and update pile size 
     83               ! update bathy and update stack size 
    8684               CALL del_head_idx(seed)  
    8785               ! 
    … …  
    143141      !! 
    144142      !!---------------------------------------------------------------------- 
    145       INTEGER,                    INTENT(in)    :: kiseed, kjseed 
    146       REAL(wp),                   INTENT(in)    :: rfill    ! filling value 
    147       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: rdta     ! input data 
    148       REAL(wp), DIMENSION(jpi,jpj) :: rseedmap, rseedmap_b  
    149   
    150       INTEGER :: ip=0                     ! size of the pile 
     143      INTEGER,                      INTENT(in)    :: kiseed, kjseed ! seed 
     144      REAL(wp),                     INTENT(in)    :: rfill          ! filling value 
     145      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: rdta           ! input data 
     146      REAL(wp), DIMENSION(jpi,jpj) :: rseedmap, rseedmap_b          ! location of new seed (used for processor exchange) 
     147  
    151148      INTEGER :: ii  , ij  , jj, kii, kjj     ! working integer 
    152       INTEGER :: iip1, ijp1               ! working integer 
    153       INTEGER :: iim1, ijm1 
    154       INTEGER :: nseed 
     149      INTEGER :: iip1, ijp1                   ! working integer 
     150      INTEGER :: iim1, ijm1                   ! working integer 
     151      INTEGER :: nseed                        ! size of the stack 
    155152      TYPE (idx), POINTER :: seed 
    156153      !!---------------------------------------------------------------------- 
    … …  
    173170      nseed=SUM(rseedmap); IF( lk_mpp )   CALL mpp_sum('domutil', nseed )  ! nseed =0 means on land => WARNING later on 
    174171      ! 
    175       ! loop until the pile size is 0 or if the pool is larger than the critical size 
     172      ! loop until the stack size is 0 or if the pool is larger than the critical size 
    176173      IF (nseed > 0) THEN 
    177174         ! seed on ocean continue 
    178175         DO WHILE ( nseed .NE. 0 ) 
    179176            DO WHILE ( ASSOCIATED(seed) ) 
    180                ip=ip+1 
    181177               ii=seed%i; ij=seed%j ; rseedmap(ii,ij)=1. 
    182                ! update pile size 
     178               ! update stack size 
    183179               CALL del_head_idx(seed)  
    184180               !  
    … …  
    226222   ! subroutine to deals with link list 
    227223   ! 
    228    SUBROUTINE create_idx(pt_idx, ki, kj, kk) 
    229       TYPE (idx), POINTER :: pt_idx 
    230       INTEGER, INTENT(in) :: ki, kj, kk 
    231       ! 
    232       ! initialised all field to NULL() 
    233       NULLIFY(pt_idx) 
    234       ! 
    235       ! allocate new element 
    236       ALLOCATE(pt_idx) 
    237       pt_idx%i=ki ; pt_idx%j=kj ; pt_idx%k=kk ; 
    238       pt_idx%next => NULL()   
    239    END SUBROUTINE create_idx 
    240  
    241224   SUBROUTINE add_head_idx(pt_idx, ki, kj, kk) 
     225      !!--------------------------------------------------------------------- 
     226      !!                  ***  ROUTINE add_head_idx  *** 
     227      !! 
     228      !! ** Purpose : add one element in the linked list 
     229      !! 
     230      !! ** Method  :  allocate one element, then point %next to the linked list 
     231      !!---------------------------------------------------------------------- 
    242232      TYPE (idx), POINTER :: pt_idx 
    243233      TYPE (idx), POINTER :: zpt_new 
    … …  
    255245 
    256246   SUBROUTINE del_head_idx(pt_idx) 
     247      !!--------------------------------------------------------------------- 
     248      !!                  ***  ROUTINE del_head_idx  *** 
     249      !! 
     250      !! ** Purpose : delete one element in the linked list 
     251      !! 
     252      !! ** Method  : move the pointer to the next node  
     253      !!---------------------------------------------------------------------- 
    257254      TYPE (idx), POINTER :: pt_idx 
    258255      TYPE (idx), POINTER :: zpt_tmp 
Note: See TracChangeset for help on using the changeset viewer.