Changeset 4461


Ignore:
Timestamp:
2014-02-04T13:17:35+01:00 (7 years ago)
Author:
trackstand2
Message:

Remove duplicate calc of mbkmax and add debug check on tmask

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r4427 r4461  
    204204!!gm end 
    205205 
    206 !! smp FINISS  
    207 #if defined key_z_first 
    208       ! Reset mbkmax to be the first level for which tmask is zero 
    209       DO jj = 1, jpj 
    210          DO ji = 1, jpi 
    211             mbkmax(ji,jj) = 1  
    212             kloop: DO jk = 1, jpkorig 
    213                IF (tmask(ji,jj,jk) == 0.0_wp) THEN 
    214                   mbkmax(ji,jj) = jk 
    215                   EXIT kloop 
    216                END IF  
    217             END DO kloop 
    218             IF (mbkmax(ji,jj) > jpk) THEN 
    219                WRITE (*,*) 'FINISS error: mbkmax(',ji,',',jj,') > jpk (',jpk,') on subdomain ',narea 
    220                mbkmax(ji,jj) = jpk 
    221             END IF 
    222          END DO 
    223       END DO 
    224 #endif 
     206!! smp FINISS ARP done in mpp_init3 now because needed prior to comms tests. 
     207!!$#if defined key_z_first 
     208!!$      ! Reset mbkmax to be the first level for which tmask is zero 
     209!!$      DO jj = 1, jpj 
     210!!$         DO ji = 1, jpi 
     211!!$            mbkmax(ji,jj) = 1  
     212!!$            kloop: DO jk = 1, jpkorig 
     213!!$               IF (tmask(ji,jj,jk) == 0.0_wp) THEN 
     214!!$                  mbkmax(ji,jj) = jk 
     215!!$                  EXIT kloop 
     216!!$               END IF  
     217!!$            END DO kloop 
     218!!$            IF (mbkmax(ji,jj) > jpk) THEN 
     219!!$               WRITE (*,*) 'FINISS error: mbkmax(',ji,',',jj,') > jpk (',jpk,') on subdomain ',narea 
     220!!$               mbkmax(ji,jj) = jpk 
     221!!$            END IF 
     222!!$         END DO 
     223!!$      END DO 
     224!!$#endif 
    225225 
    226226      ! Interior domain mask (used for global sum) 
     
    494494         iwrk_not_released(2, 1)  )   CALL ctl_stop('dom_msk: failed to release workspace arrays') 
    495495      ! 
     496!ARPDBG - check tmask values! 
     497      IF( ANY(tmask > 1.0_wp) )THEN 
     498         WRITE (*,*) narea,': ARPDBG: tmask > 1!' 
     499      END IF 
     500 
    496501   END SUBROUTINE dom_msk 
    497502 
Note: See TracChangeset for help on using the changeset viewer.