Changeset 5945 for branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90

Timestamp:

2015-11-29T20:44:49+01:00 (8 years ago)

Author:

mathiot

Message:

ice sheet coupling: changes based on reviewer comments

File:

• branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90 (modified) (9 diffs)

branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/iscplhsb.F90

@@ -70 +70 @@
       REAL(wp), DIMENSION(:), ALLOCATABLE :: zlon, zlat
       REAL(wp), DIMENSION(:), ALLOCATABLE :: zcorr_vol, zcorr_tem, zcorr_sal
-      INTEGER , DIMENSION(:), ALLOCATABLE :: ixpts, iypts, izpts, vnpts
+      INTEGER , DIMENSION(:), ALLOCATABLE :: ixpts, iypts, izpts, inpts
       INTEGER :: jpts, npts
 
@@ -131 +131 @@
                        &    + e12t(jim1,jj  ) * tmask(jim1,jj  ,jk) + e12t(jip1,jj  ) * tmask(jip1,jj  ,jk)
 
-                     IF ( zsum .NE. 0._wp ) THEN
+                     IF ( zsum /= 0._wp ) THEN
                         zjip1_ratio   = e12t(jip1,jj  ) * tmask(jip1,jj  ,jk) / zsum
                         zjim1_ratio   = e12t(jim1,jj  ) * tmask(jim1,jj  ,jk) / zsum
@@ -155 +155 @@
                         pts_flx (ji,jj,jk,jp_tem) = 0._wp
 
-                     ELSE IF (zsum .EQ. 0._wp ) THEN
+                     ELSE IF (zsum == 0._wp ) THEN
                         ! case where we close a cell and no adjacent cell open
                         ! check if the cell beneath is wet
-                        IF ( tmask(ji,jj,jk+1) .EQ. 1._wp ) THEN
+                        IF ( tmask(ji,jj,jk+1) == 1._wp ) THEN
                            pvol_flx(ji,jj,jk+1)       =  pvol_flx(ji,jj,jk+1)        + pvol_flx(ji,jj,jk)
                            pts_flx (ji,jj,jk+1,jp_sal)=  pts_flx (ji,jj,jk+1,jp_sal) + pts_flx (ji,jj,jk,jp_sal)
@@ -169 +169 @@
                         ELSE
                         ! case no adjacent cell on the horizontal and on the vertical
+                           IF ( lwp ) THEN   ! JMM : cAution this warning may occur on any mpp subdomain but numout is only
+                                             ! open for narea== 1 (lwp=T)
                            WRITE(numout,*) 'W A R N I N G iscpl: no adjacent cell on the vertical and horizontal'
                            WRITE(numout,*) '                     ',mig(ji),' ',mjg(jj),' ',jk
                            WRITE(numout,*) '                     ',ji,' ',jj,' ',jk,' ',narea
                            WRITE(numout,*) ' we are now looking for the closest wet cell on the horizontal '
+                           ENDIF
                         ! We deal with these points later.
                         END IF
@@ -188 +191 @@
       ! if no neighbour wet cell in case of 2close a cell", need to find the nearest wet point 
       ! allocation and initialisation of the list of problematic point
-      ALLOCATE(vnpts(jpnij))
-      vnpts(:)=0
+      ALLOCATE(inpts(jpnij))
+      inpts(:)=0
 
       ! fill narea location with the number of problematic point
@@ -197 +200 @@
                IF (     ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1)  == 0._wp .AND. tmask_h(ji,jj) == 1._wp  &
                   .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN
-                  vnpts(narea) = vnpts(narea) + 1 
+                  inpts(narea) = inpts(narea) + 1 
                END IF
             END DO
@@ -204 +207 @@
 
       ! build array of total problematic point on each cpu (share to each cpu)
-      CALL mpp_max(vnpts,jpnij) 
+      CALL mpp_max(inpts,jpnij) 
 
       ! size of the new variable
-      npts  = SUM(vnpts)    
+      npts  = SUM(inpts)    
       
       ! allocation of the coordinates, correction, index vector for the problematic points 
       ALLOCATE(ixpts(npts), iypts(npts), izpts(npts), zcorr_vol(npts), zcorr_sal(npts), zcorr_tem(npts), zlon(npts), zlat(npts))
-      ixpts(:) = -9999 ; iypts(:) = -9999 ; izpts(:) = -9999 ; zlon(:) = -1.0e20 ; zlat(:) = -1.0e20
-      zcorr_vol(:) = -1.0e20
-      zcorr_sal(:) = -1.0e20
-      zcorr_tem(:) = -1.0e20
+      ixpts(:) = -9999 ; iypts(:) = -9999 ; izpts(:) = -9999 ; zlon(:) = -1.0e20_wp ; zlat(:) = -1.0e20_wp
+      zcorr_vol(:) = -1.0e20_wp
+      zcorr_sal(:) = -1.0e20_wp
+      zcorr_tem(:) = -1.0e20_wp
 
       ! fill new variable
-      jpts = SUM(vnpts(1:narea-1))
+      jpts = SUM(inpts(1:narea-1))
       DO jk = 1,jpk-1
          DO jj = 2,jpj-1
@@ -223 +226 @@
                IF (     ptmask_b(ji,jj,jk) == 1._wp .AND. tmask(ji,jj,jk+1)  == 0._wp .AND. tmask_h(ji,jj) == 1._wp  &
                   .AND. SUM(tmask(ji-1:ji+1,jj,jk)) + SUM(tmask(ji,jj-1:jj+1,jk)) == 0._wp) THEN
-                  jpts = jpts + 1  ! positioning in the vnpts vector for the area narea
+                  jpts = jpts + 1  ! positioning in the inpts vector for the area narea
                   ixpts(jpts) = ji           ; iypts(jpts) = jj ; izpts(jpts) = jk
                   zlon (jpts) = glamt(ji,jj) ; zlat (jpts) = gphit(ji,jj)
@@ -273 +276 @@
 
       ! deallocate variables 
-      DEALLOCATE(vnpts)
+      DEALLOCATE(inpts)
       DEALLOCATE(ixpts, iypts, izpts, zcorr_vol, zcorr_sal, zcorr_tem, zlon, zlat)