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 9019 for branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90 – NEMO

Ignore:
Timestamp:
2017-12-13T15:58:53+01:00 (6 years ago)
Author:
timgraham
Message:

Merge of dev_CNRS_2017 into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r7646 r9019  
    2929   USE lib_mpp        ! for mpp_sum   
    3030   USE iom            ! I/O 
    31    USE wrk_nemo       ! Memory Allocation 
    3231   USE timing         ! Timing 
    3332 
     
    117116      ! 
    118117   END SUBROUTINE bdy_init 
    119     
     118 
     119 
    120120   SUBROUTINE bdy_segs 
    121121      !!---------------------------------------------------------------------- 
     
    129129      !! ** Input   :  bdy_init.nc, input file for unstructured open boundaries 
    130130      !!----------------------------------------------------------------------       
    131  
    132       ! local variables 
    133       !------------------- 
    134131      INTEGER  ::   ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices 
    135132      INTEGER  ::   icount, icountr, ibr_max, ilen1, ibm1  ! local integers 
     
    151148      INTEGER :: com_east_b, com_west_b, com_south_b, com_north_b  ! Flags for boundaries receiving 
    152149      INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4)                ! Arrays for neighbours coordinates 
    153       REAL(wp), POINTER, DIMENSION(:,:)      ::   zfmask  ! temporary fmask array excluding coastal boundary condition (shlat) 
     150      REAL(wp), TARGET, DIMENSION(jpi,jpj) ::   zfmask  ! temporary fmask array excluding coastal boundary condition (shlat) 
    154151      !! 
    155152      CHARACTER(LEN=1)                     ::   ctypebdy   !     -        -  
     
    351348        IF(lwp) WRITE(numout,*) 
    352349 
    353 #if defined key_lim2 
    354         IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  ' 
    355         SELECT CASE( cn_ice_lim(ib_bdy) )                   
    356           CASE('none') 
     350#if defined key_lim3 
     351         IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  ' 
     352         SELECT CASE( cn_ice_lim(ib_bdy) )                   
     353         CASE('none') 
    357354             IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    358              dta_bdy(ib_bdy)%ll_frld = .false. 
    359              dta_bdy(ib_bdy)%ll_hicif = .false. 
    360              dta_bdy(ib_bdy)%ll_hsnif = .false. 
    361           CASE('frs') 
     355             dta_bdy(ib_bdy)%ll_a_i = .false. 
     356             dta_bdy(ib_bdy)%ll_h_i = .false. 
     357             dta_bdy(ib_bdy)%ll_h_s = .false. 
     358         CASE('frs') 
    362359             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    363              dta_bdy(ib_bdy)%ll_frld  = .true. 
    364              dta_bdy(ib_bdy)%ll_hicif = .true. 
    365              dta_bdy(ib_bdy)%ll_hsnif = .true. 
    366           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice_lim' ) 
    367         END SELECT 
    368         IF( cn_ice_lim(ib_bdy) /= 'none' ) THEN  
    369            SELECT CASE( nn_ice_lim_dta(ib_bdy) )                   !  
    370               CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
    371               CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      boundary data taken from file' 
    372               CASE DEFAULT   ;   CALL ctl_stop( 'nn_ice_lim_dta must be 0 or 1' ) 
    373            END SELECT 
    374         ENDIF 
    375         IF(lwp) WRITE(numout,*) 
    376 #elif defined key_lim3 
    377         IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  ' 
    378         SELECT CASE( cn_ice_lim(ib_bdy) )                   
    379           CASE('none') 
    380              IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    381              dta_bdy(ib_bdy)%ll_a_i  = .false. 
    382              dta_bdy(ib_bdy)%ll_ht_i = .false. 
    383              dta_bdy(ib_bdy)%ll_ht_s = .false. 
    384           CASE('frs') 
    385              IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    386              dta_bdy(ib_bdy)%ll_a_i  = .true. 
    387              dta_bdy(ib_bdy)%ll_ht_i = .true. 
    388              dta_bdy(ib_bdy)%ll_ht_s = .true. 
    389           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice_lim' ) 
    390         END SELECT 
     360             dta_bdy(ib_bdy)%ll_a_i = .true. 
     361             dta_bdy(ib_bdy)%ll_h_i = .true. 
     362             dta_bdy(ib_bdy)%ll_h_s = .true. 
     363         CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice_lim' ) 
     364         END SELECT 
    391365        IF( cn_ice_lim(ib_bdy) /= 'none' ) THEN  
    392366           SELECT CASE( nn_ice_lim_dta(ib_bdy) )                   !  
     
    404378        IF(lwp) WRITE(numout,*) '      Width of relaxation zone = ', nn_rimwidth(ib_bdy) 
    405379        IF(lwp) WRITE(numout,*) 
    406  
    407       ENDDO 
    408  
    409      IF (nb_bdy .gt. 0) THEN 
     380         ! 
     381      END DO 
     382 
     383     IF( nb_bdy > 0 ) THEN 
    410384        IF( ln_vol ) THEN                     ! check volume conservation (nn_volctl value) 
    411385          IF(lwp) WRITE(numout,*) 'Volume correction applied at open boundaries' 
     
    528502            DO igrd = 1, jpbgrd 
    529503               id_dummy = iom_varid( inum, 'nbi'//cgrid(igrd), kdimsz=kdimsz )   
    530                !clem nblendta(igrd,ib_bdy) = kdimsz(1) 
    531                !clem jpbdtau = MAX(jpbdtau, kdimsz(1)) 
    532504               nblendta(igrd,ib_bdy) = MAXVAL(kdimsz) 
    533505               jpbdtau = MAX(jpbdtau, MAXVAL(kdimsz)) 
     
    919891                  IF( nbrdta(ib,igrd,ib_bdy) == 1 )   icountr = icountr+1 
    920892               ENDIF 
    921             ENDDO 
     893            END DO 
    922894            idx_bdy(ib_bdy)%nblenrim(igrd) = icountr !: length of rim boundary data on each proc 
    923895            idx_bdy(ib_bdy)%nblen   (igrd) = icount  !: length of boundary data on each proc         
    924          ENDDO  ! igrd 
     896         END DO  ! igrd 
    925897 
    926898         ! Allocate index arrays for this boundary set 
    927899         !-------------------------------------------- 
    928900         ilen1 = MAXVAL( idx_bdy(ib_bdy)%nblen(:) ) 
    929          ALLOCATE( idx_bdy(ib_bdy)%nbi   (ilen1,jpbgrd) ) 
    930          ALLOCATE( idx_bdy(ib_bdy)%nbj   (ilen1,jpbgrd) ) 
    931          ALLOCATE( idx_bdy(ib_bdy)%nbr   (ilen1,jpbgrd) ) 
    932          ALLOCATE( idx_bdy(ib_bdy)%nbd   (ilen1,jpbgrd) ) 
    933          ALLOCATE( idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) ) 
    934          ALLOCATE( idx_bdy(ib_bdy)%nbmap (ilen1,jpbgrd) ) 
    935          ALLOCATE( idx_bdy(ib_bdy)%nbw   (ilen1,jpbgrd) ) 
    936          ALLOCATE( idx_bdy(ib_bdy)%flagu (ilen1,jpbgrd) ) 
    937          ALLOCATE( idx_bdy(ib_bdy)%flagv (ilen1,jpbgrd) ) 
     901         ALLOCATE( idx_bdy(ib_bdy)%nbi   (ilen1,jpbgrd) ,   & 
     902            &      idx_bdy(ib_bdy)%nbj   (ilen1,jpbgrd) ,   & 
     903            &      idx_bdy(ib_bdy)%nbr   (ilen1,jpbgrd) ,   & 
     904            &      idx_bdy(ib_bdy)%nbd   (ilen1,jpbgrd) ,   & 
     905            &      idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) ,   & 
     906            &      idx_bdy(ib_bdy)%nbmap (ilen1,jpbgrd) ,   & 
     907            &      idx_bdy(ib_bdy)%nbw   (ilen1,jpbgrd) ,   & 
     908            &      idx_bdy(ib_bdy)%flagu (ilen1,jpbgrd) ,   & 
     909            &      idx_bdy(ib_bdy)%flagv (ilen1,jpbgrd) ) 
    938910 
    939911         ! Dispatch mapping indices and discrete distances on each processor 
     
    11481120         END DO  
    11491121 
    1150       ENDDO 
     1122      END DO 
    11511123 
    11521124      ! ------------------------------------------------------ 
     
    12121184        DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
    12131185          bdyvmask(idx_bdy(ib_bdy)%nbi(ib,igrd), idx_bdy(ib_bdy)%nbj(ib,igrd)) = 0._wp 
    1214         ENDDO 
    1215       ENDDO 
     1186        END DO 
     1187      END DO 
    12161188 
    12171189      ! For the flagu/flagv calculation below we require a version of fmask without 
    12181190      ! the land boundary condition (shlat) included: 
    1219       CALL wrk_alloc(jpi,jpj,  zfmask )  
    12201191      DO ij = 2, jpjm1 
    12211192         DO ii = 2, jpim1 
     
    12411212         ! flagu =  1 : u is normal to the boundary and is direction is inward 
    12421213   
    1243          DO igrd = 1,jpbgrd  
     1214         DO igrd = 1, jpbgrd  
    12441215            SELECT CASE( igrd ) 
    12451216               CASE( 1 )   ;   pmask => umask   (:,:,1)   ;   i_offset = 0 
     
    13461317      IF( nb_bdy>0 )   DEALLOCATE( nbidta, nbjdta, nbrdta ) 
    13471318      ! 
    1348       CALL wrk_dealloc(jpi,jpj,   zfmask )  
    1349       ! 
    13501319      IF( nn_timing == 1 )   CALL timing_stop('bdy_segs') 
    13511320      ! 
    13521321   END SUBROUTINE bdy_segs 
     1322 
    13531323 
    13541324   SUBROUTINE bdy_ctl_seg 
     
    17271697   END SUBROUTINE bdy_ctl_seg 
    17281698 
     1699 
    17291700   SUBROUTINE bdy_ctl_corn( ib1, ib2 ) 
    17301701      !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.