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

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)

File:

• NEMO/branches/2019/ENHANCE-03_domcfg/src/domutl.F90 (modified) (6 diffs)

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

@@ -45 +45 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER,                          INTENT(in)    :: kiseed, kjseed, kkseed
-      REAL(wp),                         INTENT(in)    :: rfill    ! filling value
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: rdta     ! input data
-      REAL(wp), DIMENSION(jpi,jpj,jpk)                :: rseedmap, rseedmap_b  !
- 
-      INTEGER :: ip=0                 ! size of the pile
+      INTEGER,                          INTENT(in)    :: kiseed, kjseed, kkseed ! seed
+      REAL(wp),                         INTENT(in)    :: rfill                  ! filling value
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: rdta                   ! input data
+      REAL(wp), DIMENSION(jpi,jpj,jpk)                :: rseedmap, rseedmap_b   ! map of seed (use for processor communication)
+ 
       INTEGER :: ii  , ij  , ik   , kii, kjj, jj, kk    ! working integer
-      INTEGER :: iip1, ijp1, ikp1
-      INTEGER :: iim1, ijm1, ikm1
-      INTEGER :: nseed
+      INTEGER :: iip1, ijp1, ikp1                       ! working integer
+      INTEGER :: iim1, ijm1, ikm1                       ! working integer
+      INTEGER :: nseed                                  ! size of the stack
       TYPE (idx), POINTER :: seed
       !!---------------------------------------------------------------------- 
@@ -75 +74 @@
       nseed=SUM(rseedmap); IF( lk_mpp )   CALL mpp_sum('domutil', nseed )  ! nseed =0 means on land => WARNING later on
       !
-      ! loop until the pile size is 0 or if the pool is larger than the critical size
+      ! loop until the stack size is 0 or if the pool is larger than the critical size
       IF (nseed > 0) THEN
          ! seed on ocean continue
          DO WHILE ( nseed /= 0 )
             DO WHILE ( ASSOCIATED(seed) )
-               ip=ip+1
                ii=seed%i; ij=seed%j ; ik=seed%k ; rseedmap(ii,ij,ik)=1.
                ! 
-               ! update bathy and update pile size
+               ! update bathy and update stack size
                CALL del_head_idx(seed) 
                !
@@ -143 +141 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER,                    INTENT(in)    :: kiseed, kjseed
-      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 
- 
-      INTEGER :: ip=0                     ! size of the pile
+      INTEGER,                      INTENT(in)    :: kiseed, kjseed ! seed
+      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)
+ 
       INTEGER :: ii  , ij  , jj, kii, kjj     ! working integer
-      INTEGER :: iip1, ijp1               ! working integer
-      INTEGER :: iim1, ijm1
-      INTEGER :: nseed
+      INTEGER :: iip1, ijp1                   ! working integer
+      INTEGER :: iim1, ijm1                   ! working integer
+      INTEGER :: nseed                        ! size of the stack
       TYPE (idx), POINTER :: seed
       !!----------------------------------------------------------------------
@@ -173 +170 @@
       nseed=SUM(rseedmap); IF( lk_mpp )   CALL mpp_sum('domutil', nseed )  ! nseed =0 means on land => WARNING later on
       !
-      ! loop until the pile size is 0 or if the pool is larger than the critical size
+      ! loop until the stack size is 0 or if the pool is larger than the critical size
       IF (nseed > 0) THEN
          ! seed on ocean continue
          DO WHILE ( nseed .NE. 0 )
             DO WHILE ( ASSOCIATED(seed) )
-               ip=ip+1
                ii=seed%i; ij=seed%j ; rseedmap(ii,ij)=1.
-               ! update pile size
+               ! update stack size
                CALL del_head_idx(seed) 
                ! 
@@ -226 +222 @@
    ! subroutine to deals with link list
    !
-   SUBROUTINE create_idx(pt_idx, ki, kj, kk)
-      TYPE (idx), POINTER :: pt_idx
-      INTEGER, INTENT(in) :: ki, kj, kk
-      !
-      ! initialised all field to NULL()
-      NULLIFY(pt_idx)
-      !
-      ! allocate new element
-      ALLOCATE(pt_idx)
-      pt_idx%i=ki ; pt_idx%j=kj ; pt_idx%k=kk ;
-      pt_idx%next => NULL()  
-   END SUBROUTINE create_idx
-
    SUBROUTINE add_head_idx(pt_idx, ki, kj, kk)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE add_head_idx  ***
+      !!
+      !! ** Purpose : add one element in the linked list
+      !!
+      !! ** Method  :  allocate one element, then point %next to the linked list
+      !!----------------------------------------------------------------------
       TYPE (idx), POINTER :: pt_idx
       TYPE (idx), POINTER :: zpt_new
@@ -255 +245 @@
 
    SUBROUTINE del_head_idx(pt_idx)
+      !!---------------------------------------------------------------------
+      !!                  ***  ROUTINE del_head_idx  ***
+      !!
+      !! ** Purpose : delete one element in the linked list
+      !!
+      !! ** Method  : move the pointer to the next node 
+      !!----------------------------------------------------------------------
       TYPE (idx), POINTER :: pt_idx
       TYPE (idx), POINTER :: zpt_tmp