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 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90 – NEMO

Ignore:
Timestamp:
2010-12-27T18:33:53+01:00 (13 years ago)
Author:
rblod
Message:

Update NEMOGCM from branch nemo_v3_3_beta

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    • Property svn:eol-style deleted
    r1707 r2528  
    55   !!====================================================================== 
    66   !! History :  OPA  ! 1987-07  (G. Madec)  Original code 
    7    !!             -   ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon) 
    8    !!             -   ! 1996-01  (G. Madec)  suppression of common work arrays 
     7   !!            6.0  ! 1993-03  (M. Guyon)  symetrical conditions (M. Guyon) 
     8   !!            7.0  ! 1996-01  (G. Madec)  suppression of common work arrays 
    99   !!             -   ! 1996-05  (G. Madec)  mask computed from tmask and sup- 
    1010   !!                 !                      pression of the double computation of bmask 
    11    !!             -   ! 1997-02  (G. Madec)  mesh information put in domhgr.F 
    12    !!             -   ! 1997-07  (G. Madec)  modification of mbathy and fmask 
     11   !!            8.0  ! 1997-02  (G. Madec)  mesh information put in domhgr.F 
     12   !!            8.1  ! 1997-07  (G. Madec)  modification of mbathy and fmask 
    1313   !!             -   ! 1998-05  (G. Roullet)  free surface 
    14    !!             -   ! 2000-03  (G. Madec)  no slip accurate 
     14   !!            8.2  ! 2000-03  (G. Madec)  no slip accurate 
    1515   !!             -   ! 2001-09  (J.-M. Molines)  Open boundaries 
    1616   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and module 
     
    4444   !! NEMO/OPA 3.2 , LODYC-IPSL  (2009) 
    4545   !! $Id$  
    46    !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)  
    47    !!---------------------------------------------------------------------- 
    48  
     46   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     47   !!---------------------------------------------------------------------- 
    4948CONTAINS 
    5049    
     
    5655      !!      zontal velocity points (u & v), vorticity points (f) and baro- 
    5756      !!      tropic stream function  points (b). 
    58       !!        Set mbathy to the number of non-zero w-levels of a water column 
    5957      !! 
    6058      !! ** Method  :   The ocean/land mask is computed from the basin bathy- 
     
    7371      !!                   or mbathy(ji+1,jj)  or mbathy(ji+1,jj+1) =< 0 
    7472      !!                1. IF mbathy( ji ,jj) and mbathy( ji ,jj+1) 
    75       !!                and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk. 
     73      !!                  and mbathy(ji+1,jj) and mbathy(ji+1,jj+1) >= jk. 
    7674      !!      b-point : the same definition as for f-point of the first ocean 
    7775      !!                level (surface level) but with 0 along coastlines. 
     76      !!      tmask_i : interior ocean mask at t-point, i.e. excluding duplicated 
     77      !!                rows/lines due to cyclic or North Fold boundaries as well 
     78      !!                as MPP halos. 
    7879      !! 
    7980      !!        The lateral friction is set through the value of fmask along 
     
    99100      !!        - bmask is  set to 0 on the open boundaries. 
    100101      !! 
    101       !!      Set mbathy to the number of non-zero w-levels of a water column 
    102       !!                  mbathy = min( mbathy, 1 ) + 1 
    103       !!      (note that the minimum value of mbathy is 2). 
    104       !! 
    105102      !! ** Action :   tmask    : land/ocean mask at t-point (=0. or 1.) 
    106103      !!               umask    : land/ocean mask at u-point (=0. or 1.) 
     
    110107      !!               bmask    : land/ocean mask at barotropic stream 
    111108      !!                          function point (=0. or 1.) and set to 0 along lateral boundaries 
    112       !!               mbathy   : number of non-zero w-levels  
     109      !!               tmask_i  : interior ocean mask 
    113110      !!---------------------------------------------------------------------- 
    114111      INTEGER  ::   ji, jj, jk      ! dummy loop indices 
     
    132129      ENDIF 
    133130 
    134       IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral free-slip ' 
     131      IF     (      rn_shlat == 0.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  free-slip ' 
    135132      ELSEIF (      rn_shlat == 2.               ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  no-slip ' 
    136133      ELSEIF ( 0. < rn_shlat .AND. rn_shlat < 2. ) THEN   ;   IF(lwp) WRITE(numout,*) '   ocean lateral  partial-slip ' 
     
    145142      ! N.B. tmask has already the right boundary conditions since mbathy is ok 
    146143      ! 
    147       tmask(:,:,:) = 0.e0 
     144      tmask(:,:,:) = 0._wp 
    148145      DO jk = 1, jpk 
    149146         DO jj = 1, jpj 
    150147            DO ji = 1, jpi 
    151                IF( REAL( mbathy(ji,jj) - jk ) +.1 >= 0.e0 )   tmask(ji,jj,jk) = 1.e0 
     148               IF( REAL( mbathy(ji,jj) - jk, wp ) + 0.1_wp >= 0._wp )   tmask(ji,jj,jk) = 1._wp 
    152149            END DO   
    153150         END DO   
     
    160157            ij0 =  87   ;   ij1 =  88 
    161158            ii0 = 160   ;   ii1 = 161 
    162             tmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0.e0 
     159            tmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 0._wp 
    163160         ELSE 
    164161            IF(lwp) WRITE(numout,*) 
     
    182179      ijl = nlcj - jprecj + 1 
    183180 
    184       tmask_i( 1 :iif,   :   ) = 0.e0      ! first columns 
    185       tmask_i(iil:jpi,   :   ) = 0.e0      ! last  columns (including mpp extra columns) 
    186       tmask_i(   :   , 1 :ijf) = 0.e0      ! first rows 
    187       tmask_i(   :   ,ijl:jpj) = 0.e0      ! last  rows (including mpp extra rows) 
     181      tmask_i( 1 :iif,   :   ) = 0._wp      ! first columns 
     182      tmask_i(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns) 
     183      tmask_i(   :   , 1 :ijf) = 0._wp      ! first rows 
     184      tmask_i(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows) 
    188185 
    189186      ! north fold mask 
    190187      ! --------------- 
    191       tpol(1:jpiglo) = 1.e0  
    192       fpol(1:jpiglo) = 1.e0 
     188      tpol(1:jpiglo) = 1._wp  
     189      fpol(1:jpiglo) = 1._wp 
    193190      IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot 
    194          tpol(jpiglo/2+1:jpiglo) = 0.e0 
    195          fpol(     1    :jpiglo) = 0.e0 
     191         tpol(jpiglo/2+1:jpiglo) = 0._wp 
     192         fpol(     1    :jpiglo) = 0._wp 
    196193         IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row 
    197194            DO ji = iif+1, iil-1 
     
    201198      ENDIF 
    202199      IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot 
    203          tpol(     1    :jpiglo) = 0.e0 
    204          fpol(jpiglo/2+1:jpiglo) = 0.e0 
     200         tpol(     1    :jpiglo) = 0._wp 
     201         fpol(jpiglo/2+1:jpiglo) = 0._wp 
    205202      ENDIF 
    206203 
     
    219216         END DO 
    220217      END DO 
    221       CALL lbc_lnk( umask, 'U', 1. )      ! Lateral boundary conditions 
    222       CALL lbc_lnk( vmask, 'V', 1. ) 
    223       CALL lbc_lnk( fmask, 'F', 1. ) 
     218      CALL lbc_lnk( umask, 'U', 1._wp )      ! Lateral boundary conditions 
     219      CALL lbc_lnk( vmask, 'V', 1._wp ) 
     220      CALL lbc_lnk( fmask, 'F', 1._wp ) 
    224221 
    225222 
     
    231228      !                                    ! cyclic east-west : bmask must be set to 0. on rows 1 and jpi 
    232229      IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN 
    233          bmask( 1 ,:) = 0.e0 
    234          bmask(jpi,:) = 0.e0 
     230         bmask( 1 ,:) = 0._wp 
     231         bmask(jpi,:) = 0._wp 
    235232      ENDIF 
    236233      IF( nperio == 2 ) THEN               ! south symmetric :  bmask must be set to 0. on row 1 
    237          bmask(:, 1 ) = 0.e0 
     234         bmask(:, 1 ) = 0._wp 
    238235      ENDIF 
    239236      !                                    ! north fold :  
     
    242239            ii = ji + nimpp - 1 
    243240            bmask(ji,jpj-1) = bmask(ji,jpj-1) * tpol(ii) 
    244             bmask(ji,jpj  ) = 0.e0 
     241            bmask(ji,jpj  ) = 0._wp 
    245242         END DO 
    246243      ENDIF 
    247244      IF( nperio == 5 .OR. nperio == 6 ) THEN   ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj 
    248          bmask(:,jpj) = 0.e0 
     245         bmask(:,jpj) = 0._wp 
    249246      ENDIF 
    250247      ! 
    251248      IF( lk_mpp ) THEN                    ! mpp specificities 
    252249         !                                      ! bmask is set to zero on the overlap region 
    253          IF( nbondi /= -1 .AND. nbondi /= 2 )   bmask(  1 :jpreci,:) = 0.e0 
    254          IF( nbondi /=  1 .AND. nbondi /= 2 )   bmask(nlci:jpi   ,:) = 0.e0 
    255          IF( nbondj /= -1 .AND. nbondj /= 2 )   bmask(:,  1 :jprecj) = 0.e0 
    256          IF( nbondj /=  1 .AND. nbondj /= 2 )   bmask(:,nlcj:jpj   ) = 0.e0 
     250         IF( nbondi /= -1 .AND. nbondi /= 2 )   bmask(  1 :jpreci,:) = 0._wp 
     251         IF( nbondi /=  1 .AND. nbondi /= 2 )   bmask(nlci:jpi   ,:) = 0._wp 
     252         IF( nbondj /= -1 .AND. nbondj /= 2 )   bmask(:,  1 :jprecj) = 0._wp 
     253         IF( nbondj /=  1 .AND. nbondj /= 2 )   bmask(:,nlcj:jpj   ) = 0._wp 
    257254         ! 
    258255         IF( npolj == 3 .OR. npolj == 4 ) THEN  ! north fold : bmask must be set to 0. on rows jpj-1 and jpj 
     
    260257               ii = ji + nimpp - 1 
    261258               bmask(ji,nlcj-1) = bmask(ji,nlcj-1) * tpol(ii) 
    262                bmask(ji,nlcj  ) = 0.e0 
     259               bmask(ji,nlcj  ) = 0._wp 
    263260            END DO 
    264261         ENDIF 
    265262         IF( npolj == 5 .OR. npolj == 6 ) THEN  ! F-pt pivot and T-pt elliptic eq. : bmask set to 0. on row jpj 
    266263            DO ji = 1, nlci 
    267                bmask(ji,nlcj  ) = 0.e0 
     264               bmask(ji,nlcj  ) = 0._wp 
    268265            END DO 
    269266         ENDIF 
     
    282279         DO jj = 2, jpjm1 
    283280            DO ji = fs_2, fs_jpim1   ! vector opt. 
    284                IF( fmask(ji,jj,jk) == 0. ) THEN 
    285                   fmask(ji,jj,jk) = rn_shlat * MIN( 1., MAX( zwf(ji+1,jj), zwf(ji,jj+1),   & 
    286                      &                                       zwf(ji-1,jj), zwf(ji,jj-1)  )  ) 
     281               IF( fmask(ji,jj,jk) == 0._wp ) THEN 
     282                  fmask(ji,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jj), zwf(ji,jj+1),   & 
     283                     &                                           zwf(ji-1,jj), zwf(ji,jj-1)  )  ) 
    287284               ENDIF 
    288285            END DO 
    289286         END DO 
    290287         DO jj = 2, jpjm1 
    291             IF( fmask(1,jj,jk) == 0. ) THEN 
    292                fmask(1  ,jj,jk) = rn_shlat * MIN( 1., MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 
    293             ENDIF 
    294             IF( fmask(jpi,jj,jk) == 0. ) THEN 
    295                fmask(jpi,jj,jk) = rn_shlat * MIN( 1., MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
     288            IF( fmask(1,jj,jk) == 0._wp ) THEN 
     289               fmask(1  ,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(2,jj), zwf(1,jj+1), zwf(1,jj-1) ) ) 
     290            ENDIF 
     291            IF( fmask(jpi,jj,jk) == 0._wp ) THEN 
     292               fmask(jpi,jj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(jpi,jj+1), zwf(jpim1,jj), zwf(jpi,jj-1) ) ) 
    296293            ENDIF 
    297294         END DO          
    298295         DO ji = 2, jpim1 
    299             IF( fmask(ji,1,jk) == 0. ) THEN 
    300                fmask(ji, 1 ,jk) = rn_shlat * MIN( 1., MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 
    301             ENDIF 
    302             IF( fmask(ji,jpj,jk) == 0. ) THEN 
    303                fmask(ji,jpj,jk) = rn_shlat * MIN( 1., MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 
     296            IF( fmask(ji,1,jk) == 0._wp ) THEN 
     297               fmask(ji, 1 ,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,1), zwf(ji,2), zwf(ji-1,1) ) ) 
     298            ENDIF 
     299            IF( fmask(ji,jpj,jk) == 0._wp ) THEN 
     300               fmask(ji,jpj,jk) = rn_shlat * MIN( 1._wp , MAX( zwf(ji+1,jpj), zwf(ji-1,jpj), zwf(ji,jpjm1) ) ) 
    304301            ENDIF 
    305302         END DO 
     
    308305      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN   ! ORCA_R2 configuration 
    309306         !                                                 ! Increased lateral friction near of some straits 
    310          IF( n_cla == 0 ) THEN 
     307         IF( nn_cla == 0 ) THEN 
    311308            !                                ! Gibraltar strait  : partial slip (fmask=0.5) 
    312309            ij0 = 101   ;   ij1 = 101 
    313             ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5e0 
     310            ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp 
    314311            ij0 = 102   ;   ij1 = 102 
    315             ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5e0 
     312            ii0 = 139   ;   ii1 = 140   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp 
    316313            ! 
    317314            !                                ! Bab el Mandeb : partial slip (fmask=1) 
    318315            ij0 =  87   ;   ij1 =  88 
    319             ii0 = 160   ;   ii1 = 160   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1.e0 
     316            ii0 = 160   ;   ii1 = 160   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp 
    320317            ij0 =  88   ;   ij1 =  88 
    321             ii0 = 159   ;   ii1 = 159   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1.e0 
     318            ii0 = 159   ;   ii1 = 159   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp 
    322319            ! 
    323320         ENDIF 
    324  
    325321         !                                ! Danish straits  : strong slip (fmask > 2) 
    326322! We keep this as an example but it is instable in this case  
    327323!         ij0 = 115   ;   ij1 = 115 
    328 !         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4.0e0 
     324!         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp 
    329325!         ij0 = 116   ;   ij1 = 116 
    330 !         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4.0e0 
     326!         ii0 = 145   ;   ii1 = 146   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) = 4._wp 
    331327         ! 
    332328      ENDIF 
    333329      ! 
    334       CALL lbc_lnk( fmask, 'F', 1. )      ! Lateral boundary conditions on fmask 
    335  
    336        
    337       ! Mbathy set to the number of w-level (minimum value 2) 
    338       ! ----------------------------------- 
    339       DO jj = 1, jpj 
    340          DO ji = 1, jpi 
    341             mbathy(ji,jj) = MAX( 1, mbathy(ji,jj) ) + 1 
    342          END DO 
    343       END DO 
    344        
     330      IF( cp_cfg == "orca" .AND. jp_cfg == 1 ) THEN   ! ORCA R1 configuration 
     331         !                                                 ! Increased lateral friction near of some straits 
     332         IF(lwp) WRITE(numout,*) 
     333         IF(lwp) WRITE(numout,*) '   orca_r1: increase friction near the following straits : ' 
     334         IF(lwp) WRITE(numout,*) '      Gibraltar ' 
     335         ii0 = 283   ;   ii1 = 284        ! Gibraltar Strait  
     336         ij0 = 200   ;   ij1 = 200   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  2._wp   
     337 
     338         IF(lwp) WRITE(numout,*) '      Bhosporus ' 
     339         ii0 = 314   ;   ii1 = 315        ! Bhosporus Strait  
     340         ij0 = 208   ;   ij1 = 208   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  2._wp   
     341 
     342         IF(lwp) WRITE(numout,*) '      Makassar (Top) ' 
     343         ii0 =  48   ;   ii1 =  48        ! Makassar Strait (Top)  
     344         ij0 = 149   ;   ij1 = 150   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  3._wp   
     345 
     346         IF(lwp) WRITE(numout,*) '      Lombok ' 
     347         ii0 =  44   ;   ii1 =  44        ! Lombok Strait  
     348         ij0 = 124   ;   ij1 = 125   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) =  2._wp   
     349 
     350         IF(lwp) WRITE(numout,*) '      Ombai ' 
     351         ii0 =  53   ;   ii1 =  53        ! Ombai Strait  
     352         ij0 = 124   ;   ij1 = 125   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp   
     353 
     354         IF(lwp) WRITE(numout,*) '      Timor Passage ' 
     355         ii0 =  56   ;   ii1 =  56        ! Timor Passage  
     356         ij0 = 124   ;   ij1 = 125   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 2._wp   
     357 
     358         IF(lwp) WRITE(numout,*) '      West Halmahera ' 
     359         ii0 =  58   ;   ii1 =  58        ! West Halmahera Strait  
     360         ij0 = 141   ;   ij1 = 142   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3._wp   
     361 
     362         IF(lwp) WRITE(numout,*) '      East Halmahera ' 
     363         ii0 =  55   ;   ii1 =  55        ! East Halmahera Strait  
     364         ij0 = 141   ;   ij1 = 142   ;   fmask( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1), 1:jpk ) = 3._wp   
     365         ! 
     366      ENDIF 
     367      ! 
     368      CALL lbc_lnk( fmask, 'F', 1._wp )      ! Lateral boundary conditions on fmask 
     369 
     370             
    345371      IF( nprint == 1 .AND. lwp ) THEN      ! Control print 
    346372         imsk(:,:) = INT( tmask_i(:,:) ) 
     
    385411         imsk(:,:) = INT( bmask(:,:) ) 
    386412         CALL prihin( imsk(:,:), jpi, jpj, 1, jpi, 1,   & 
    387                &                           1, jpj, 1, 1, numout ) 
     413            &                              1, jpj, 1, 1, numout ) 
    388414      ENDIF 
    389415      ! 
     
    404430      !! 
    405431      !! ** Action : 
    406       !! 
    407432      !!---------------------------------------------------------------------- 
    408433      INTEGER  :: ji, jj, jk, jl      ! dummy loop indices 
     
    448473               zaa = tmask(ji  ,jj,jk) + tmask(ji  ,jj+1,jk)   & 
    449474                  &+ tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk) 
    450                IF( ABS(zaa-3.) <= 0.1 )   fmask(ji,jj,jk) = 1. 
     475               IF( ABS(zaa-3._wp) <= 0.1_wp )   fmask(ji,jj,jk) = 1._wp 
    451476            END DO 
    452477         END DO 
     
    461486            DO ji = 2, jpim1 
    462487               zaa = tmask(ji+1,jj,jk) + tmask(ji+1,jj+1,jk) 
    463                IF( ABS(zaa-2.) <= 0.1 .AND. fmask(ji,jj,jk) == 0 ) THEN 
     488               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN 
    464489                  inw = inw + 1 
    465490                  nicoa(inw,1,jk) = ji 
     
    468493               ENDIF 
    469494               zaa = tmask(ji,jj,jk) + tmask(ji,jj+1,jk) 
    470                IF( ABS(zaa-2.) <= 0.1 .AND. fmask(ji,jj,jk) == 0 ) THEN 
     495               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN 
    471496                  ine = ine + 1 
    472497                  nicoa(ine,2,jk) = ji 
     
    488513            DO ji =2, jpim1 
    489514               zaa = tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) 
    490                IF( ABS(zaa-2.) <= 0.1 .AND. fmask(ji,jj,jk) == 0 ) THEN 
     515               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN 
    491516                  ins = ins + 1 
    492517                  nicoa(ins,3,jk) = ji 
     
    495520               ENDIF 
    496521               zaa = tmask(ji+1,jj,jk) + tmask(ji,jj,jk) 
    497                IF( ABS(zaa-2.) <= 0.1 .AND. fmask(ji,jj,jk) == 0 ) THEN 
     522               IF( ABS(zaa-2._wp) <= 0.1_wp .AND. fmask(ji,jj,jk) == 0._wp ) THEN 
    498523                  inn = inn + 1 
    499524                  nicoa(inn,4,jk) = ji 
     
    524549      iind = 0 
    525550      ijnd = 0 
    526       IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) iind = 2 
    527       IF( nperio == 3 .OR. nperio == 4 .OR. nperio == 5 .OR. nperio == 6 ) ijnd = 2 
     551      IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 )   iind = 2 
     552      IF( nperio == 3 .OR. nperio == 4 .OR. nperio == 5 .OR. nperio == 6 )   ijnd = 2 
    528553      DO jk = 1, jpk 
    529554         DO jl = 1, npcoa(1,jk) 
     
    551576            ENDIF 
    552577         END DO 
    553          DO jl=1,npcoa(4,jk) 
     578         DO jl = 1, npcoa(4,jk) 
    554579            IF( njcoa(jl,4,jk)-2 < 1) THEN 
    555                ierror=ierror+1 
    556                icoord(ierror,1)=nicoa(jl,4,jk) 
    557                icoord(ierror,2)=njcoa(jl,4,jk) 
    558                icoord(ierror,3)=jk 
     580               ierror=ierror + 1 
     581               icoord(ierror,1) = nicoa(jl,4,jk) 
     582               icoord(ierror,2) = njcoa(jl,4,jk) 
     583               icoord(ierror,3) = jk 
    559584            ENDIF 
    560585         END DO 
Note: See TracChangeset for help on using the changeset viewer.