Changeset 11991 for NEMO

Timestamp:

2019-11-27T18:32:01+01:00 (4 years ago)

Author:

mathiot

Message:

ENHANCE-03_closea: rm useless variable, rename some variable and add comments

Location:

NEMO/branches/2019/ENHANCE-03_domcfg/src

Files:

• dom_oce.F90 (modified) (2 diffs)
• domain.F90 (modified) (1 diff)
• domclo.F90 (modified) (9 diffs)
• domutl.F90 (modified) (3 diffs)

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

@@ -239 +239 @@
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask                        !: land/ocean mask at W- pts               
 
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_opnsea, msk_closea                 !: open ocean mask, closed sea mask (all of them)
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_glo  , msk_rnf  , msk_emp                !: closed sea masks
-   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_gloid, msk_rnfid, msk_empid              !: closed sea masks
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_opnsea  , msk_csundef                !: open ocean mask, closed sea mask (all of them)
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_csglo   , msk_csrnf   , msk_csemp    !: closed sea masks
+   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: msk_csgrpglo, msk_csgrprnf, msk_csgrpemp !: closed sea masks
 
    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4)
@@ -344 +344 @@
          &      hift  (jpi,jpj) , hifu  (jpi,jpj) , STAT=ierr(10) )
 
-      ALLOCATE( msk_opnsea(jpi,jpj), msk_closea(jpi,jpj),                   &
-         &      msk_glo  (jpi,jpj), msk_rnf  (jpi,jpj), msk_emp  (jpi,jpj), &
-         &      msk_gloid(jpi,jpj), msk_rnfid(jpi,jpj), msk_empid(jpi,jpj), STAT=ierr(11) )
+      ALLOCATE( msk_opnsea  (jpi,jpj), msk_csundef (jpi,jpj),                        &
+         &      msk_csglo   (jpi,jpj), msk_csrnf   (jpi,jpj), msk_csemp   (jpi,jpj), &
+         &      msk_csgrpglo(jpi,jpj), msk_csgrprnf(jpi,jpj), msk_csgrpemp(jpi,jpj), STAT=ierr(11) )
       !
       dom_oce_alloc = MAXVAL(ierr)

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

@@ -416 +416 @@
       IF (ln_domclo) THEN
          ! mask for the open sea
-         CALL iom_rstput( 0, 0, inum, 'mask_opensea' , msk_opnsea, ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'mask_opensea' , msk_opnsea  , ktype = jp_i4 )
          ! mask for all the under closed sea
-         CALL iom_rstput( 0, 0, inum, 'mask_csundef' , msk_closea, ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'mask_csundef' , msk_csundef , ktype = jp_i4 )
          ! mask for global, local net precip, local net precip and evaporation correction
-         CALL iom_rstput( 0, 0, inum, 'mask_csglo'   , msk_glo   , ktype = jp_i4 )
-         CALL iom_rstput( 0, 0, inum, 'mask_csemp'   , msk_emp   , ktype = jp_i4 )
-         CALL iom_rstput( 0, 0, inum, 'mask_csrnf'   , msk_rnf   , ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'mask_csglo'   , msk_csglo   , ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'mask_csemp'   , msk_csemp   , ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'mask_csrnf'   , msk_csrnf   , ktype = jp_i4 )
          ! mask for the various river mouth (in case multiple lake in the same outlet)
-         CALL iom_rstput( 0, 0, inum, 'mask_csgrpglo', msk_gloid , ktype = jp_i4 )
-         CALL iom_rstput( 0, 0, inum, 'mask_csgrpemp', msk_empid , ktype = jp_i4 )
-         CALL iom_rstput( 0, 0, inum, 'mask_csgrprnf', msk_rnfid , ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'mask_csgrpglo', msk_csgrpglo, ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'mask_csgrpemp', msk_csgrpemp, ktype = jp_i4 )
+         CALL iom_rstput( 0, 0, inum, 'mask_csgrprnf', msk_csgrprnf, ktype = jp_i4 )
       END IF
       !

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

@@ -108 +108 @@
       CALL dom_ngb(rn_lon_opnsea, rn_lat_opnsea, jiseed, jjseed, zdistseed, 'T')
 
-      !! 1.2 fill select cell to -1
+      !! 1.2 fill connected cell to -1
       CALL fill_pool( jiseed, jjseed, msk_opnsea, -1._wp )
 
@@ -134 +134 @@
       !! 1.4 Define closed sea mask (all of them, ie defined in the namelist or not)
       !! needed to remove the undefined closed seas at the end
-      msk_closea(:,:) = ( ssmask(:,:) - msk_opnsea(:,:) ) * 99._wp
+      msk_csundef(:,:) = ( ssmask(:,:) - msk_opnsea(:,:) ) * 99._wp
 
       !!----------------------------------------------------------------------
@@ -143 +143 @@
       jglo = 1 ; jrnf = 1 ; jemp = 1
       !! mask used to group lake by net evap/precip distribution technics
-      msk_glo(:,:) = msk_closea(:,:)
-      msk_rnf(:,:) = msk_closea(:,:)
-      msk_emp(:,:) = msk_closea(:,:)
-
-      !! mask used to group multiple lake with the same river mouth (great lake for example)
-      msk_gloid(:,:) = 0.0_wp
-      msk_rnfid(:,:) = 0.0_wp
-      msk_empid(:,:) = 0.0_wp
+      msk_csglo(:,:) = msk_csundef(:,:)
+      msk_csrnf(:,:) = msk_csundef(:,:)
+      msk_csemp(:,:) = msk_csundef(:,:)
+
+      !! mask used to define group of lake sharing the same river mouth
+      msk_csgrpglo(:,:) = 0.0_wp
+      msk_csgrprnf(:,:) = 0.0_wp
+      msk_csgrpemp(:,:) = 0.0_wp
 
       IF (lwp) WRITE(numout,*)'closed seas: '
@@ -164 +164 @@
          CASE('glo')
             jsch = jglo
-            zmsksrc(:,:) = msk_glo(:,:)
-            zmsktrg(:,:) = msk_gloid(:,:)
+            zmsksrc(:,:) = msk_csglo(:,:)
+            zmsktrg(:,:) = msk_csgrpglo(:,:)
          CASE('rnf') 
             jsch = jrnf
-            zmsksrc(:,:) = msk_rnf(:,:)
-            zmsktrg(:,:) = msk_rnfid(:,:)
+            zmsksrc(:,:) = msk_csrnf(:,:)
+            zmsktrg(:,:) = msk_csgrprnf(:,:)
          CASE('emp')
             jsch = jemp 
-            zmsksrc(:,:) = msk_emp(:,:)
-            zmsktrg(:,:) = msk_empid(:,:)
+            zmsksrc(:,:) = msk_csemp(:,:)
+            zmsktrg(:,:) = msk_csgrpemp(:,:)
          CASE DEFAULT
             CALL ctl_stop( 'STOP', 'domclo: ',TRIM(csch),' is an unknown target type for lake (should be glo, emp, rnf)' )
@@ -186 +186 @@
 
          !! sanity check on the msk value (closea mask should be 99 otherwise, lake already processed)
-         !! check if some lake are not connected
+         !! check if seed on land or lake already processed
          zchk = 0._wp
-         IF (mi0(jiseed) == mi1(jiseed) .AND. mj0(jjseed) == mj1(jjseed)) zchk = msk_closea(mi0(jiseed),mj0(jjseed))
+         IF (mi0(jiseed) == mi1(jiseed) .AND. mj0(jjseed) == mj1(jjseed)) zchk = msk_csundef(mi0(jiseed),mj0(jjseed))
          CALL mpp_max('domclo',zchk)
          
@@ -215 +215 @@
 
             !! fill close sea mask with counter value
+            !! and update undefined closed sea mask
             CALL fill_pool( jiseed, jjseed, zmsksrc, REAL(jsch  ,8))
             WHERE (zmsksrc(:,:) == REAL(jsch,8))
-               msk_closea = 0._wp
+               msk_csundef = 0._wp
                zmsktrg    = sn_lake(jcs)%idtrg
             END WHERE
@@ -224 +225 @@
             IF (cloc /= 'global') THEN
 
-               !! set a minimum value for radius of the river influence
+               !! set value for radius of the river influence
                zradtrg = 0._wp
                IF (mi0(jiseed) == mi1(jiseed) .AND. mj0(jjseed) == mj1(jjseed)) THEN
@@ -290 +291 @@
             CASE ('glo')
                jglo = jglo + 1
-               msk_glo(:,:)   = zmsksrc(:,:)
-               msk_gloid(:,:) = zmsktrg(:,:)
+               msk_csglo(:,:)    = zmsksrc(:,:)
+               msk_csgrpglo(:,:) = zmsktrg(:,:)
                IF (lwp) WRITE(numout,*)'        net evap/precip will be spread globally (glo)'
             CASE ('rnf')
                jrnf = jrnf + 1
-               msk_rnf(:,:)   = zmsksrc(:,:)
-               msk_rnfid(:,:) = zmsktrg(:,:)
+               msk_csrnf(:,:)    = zmsksrc(:,:)
+               msk_csgrprnf(:,:) = zmsktrg(:,:)
                IF (lwp) WRITE(numout,*)'        net precip will be spread locally and net evap globally (rnf)'
             CASE ('emp')
                jemp = jemp + 1
-               msk_emp(:,:)   = zmsksrc(:,:)
-               msk_empid(:,:) = zmsktrg(:,:)
+               msk_csemp(:,:)    = zmsksrc(:,:)
+               msk_csgrpemp(:,:) = zmsktrg(:,:)
                IF (lwp) WRITE(numout,*)'        net evap/precip will be spread locally (emp)'
             END SELECT
@@ -314 +315 @@
 
       !! mask all the cells not defined as closed sea
-      WHERE ( msk_glo(:,:) == 99._wp )  msk_glo = 0._wp
-      WHERE ( msk_rnf(:,:) == 99._wp )  msk_rnf = 0._wp
-      WHERE ( msk_emp(:,:) == 99._wp )  msk_emp = 0._wp
+      WHERE ( msk_csglo(:,:) == 99._wp )  msk_csglo = 0._wp
+      WHERE ( msk_csrnf(:,:) == 99._wp )  msk_csrnf = 0._wp
+      WHERE ( msk_csemp(:,:) == 99._wp )  msk_csemp = 0._wp
 
       !!  non defined closed sea
-      WHERE ( msk_closea(:,:) > 0._wp ) msk_closea = 1._wp
+      WHERE ( msk_csundef(:,:) > 0._wp ) msk_csundef = 1._wp
 
    END SUBROUTINE dom_clo

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

@@ -144 +144 @@
       REAL(wp),                     INTENT(in)    :: rfill          ! filling value
       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: rdta           ! input data
-      REAL(wp), DIMENSION(jpi,jpj) :: rseedmap, rseedmap_b          ! location of new seed (used for processor exchange)
+      REAL(wp), DIMENSION(jpi,jpj) :: rseedmap                      ! location of new seed (used for processor exchange)
  
       INTEGER :: ii  , ij  , jj, kii, kjj     ! working integer
@@ -175 +175 @@
          DO WHILE ( nseed .NE. 0 )
             DO WHILE ( ASSOCIATED(seed) )
-               ii=seed%i; ij=seed%j ; rseedmap(ii,ij)=1.
+               ii=seed%i; ij=seed%j
                ! update stack size
                CALL del_head_idx(seed) 
@@ -197 +197 @@
             nseed=SUM(rseedmap); IF( lk_mpp )   CALL mpp_sum('domutil', nseed )  ! this is the sum of all the point check this iteration
             !
-            rseedmap_b(:,:)=rseedmap(:,:)
             CALL lbc_lnk('domutil', rseedmap, 'T', 1.)
             !
             ! build new list of seed
+            ! new seed only if data > 0 (ie not land), data not already filled and rseedmap > 0
             DO ii=1,jpi
                DO jj=1,jpj
-                  IF (rseedmap(ii,jj) > 0.0 .AND. rseedmap(ii,jj) /= rseedmap_b(ii,jj) .AND. rdta(ii,jj) > 0 .AND. rdta(ii,jj) /= rfill) THEN
+                  IF (rseedmap(ii,jj) > 0.0 .AND. rdta(ii,jj) > 0 .AND. rdta(ii,jj) /= rfill) THEN
                      CALL add_head_idx(seed, ii, jj, 1)
                   END IF