Ignore:
Timestamp:
2020-09-25T18:00:14+02:00 (7 months ago)
Author:
smasson
Message:

trunk: missing parts of [13526] + soem cleaning

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/TOP/trcbdy.F90

    r13226 r13527  
    4949      INTEGER                           :: ib_bdy ,ir, jn ,igrd ! Loop indices 
    5050      REAL(wp), POINTER, DIMENSION(:,:) ::  ztrc 
    51       REAL(wp), POINTER                 ::  zfac 
    5251      LOGICAL                           :: llrim0               ! indicate if rim 0 is treated 
    5352      LOGICAL, DIMENSION(4)             :: llsend1, llrecv1     ! indicate how communications are to be carried out 
     
    6160         IF( ir == 0 ) THEN   ;   llrim0 = .TRUE. 
    6261         ELSE                 ;   llrim0 = .FALSE. 
    63          END IF 
     62         ENDIF 
    6463         DO ib_bdy=1, nb_bdy 
     64            ! 
    6565            DO jn = 1, jptra 
    6666               ! 
    67                ztrc => trcdta_bdy(jn,ib_bdy)%trc  
    68                zfac => trcdta_bdy(jn,ib_bdy)%rn_fac 
     67               IF( ASSOCIATED(trcdta_bdy(jn,ib_bdy)%trc) .AND. trcdta_bdy(jn,ib_bdy)%cn_obc /= 'neumann' ) THEN 
     68                  IF( .NOT. ASSOCIATED(ztrc) )   ALLOCATE( ztrc(idx_bdy(ib_bdy)%nblen(igrd),jpk) ) 
     69                  ztrc(:,:) = trcdta_bdy(jn,ib_bdy)%trc(:,:) * trcdta_bdy(jn,ib_bdy)%rn_fac 
     70               ENDIF 
    6971               ! 
    70                SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc) ) 
     72               SELECT CASE( trcdta_bdy(jn,ib_bdy)%cn_obc ) 
    7173               CASE('none'        )   ;   CYCLE 
    7274               CASE('frs'         )   ! treat the whole boundary at once 
    73                   IF( ir == 0 ) CALL bdy_frs( idx_bdy(ib_bdy),                tr(:,:,:,jn,Krhs), ztrc*zfac ) 
     75                  IF( ir == 0 )           CALL bdy_frs( idx_bdy(ib_bdy),                   tr(:,:,:,jn,Krhs), ztrc ) 
    7476               CASE('specified'   )   ! treat the whole rim      at once 
    75                   IF( ir == 0 ) CALL bdy_spe( idx_bdy(ib_bdy),                tr(:,:,:,jn,Krhs), ztrc*zfac ) 
    76                CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd         , tr(:,:,:,jn,Krhs) )   ! tra masked 
    77                CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc*zfac, ll_npo=.false. ) 
    78                CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc*zfac, ll_npo=.true. ) 
     77                  IF( ir == 0 )           CALL bdy_spe( idx_bdy(ib_bdy),                   tr(:,:,:,jn,Krhs), ztrc ) 
     78               CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd            , tr(:,:,:,jn,Krhs),       llrim0 )   ! tra masked 
     79               CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc, llrim0,   & 
     80                  &                                     ll_npo=.FALSE. ) 
     81               CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), tr(:,:,:,jn,Kbb), tr(:,:,:,jn,Krhs), ztrc, llrim0,   & 
     82                  &                                     ll_npo=.TRUE.  ) 
    7983               CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 
    8084               END SELECT 
    8185               ! 
    8286            END DO 
     87            ! 
     88            IF( ASSOCIATED(ztrc) )   DEALLOCATE(ztrc) 
     89            ! 
    8390         END DO 
    8491         ! 
    8592         IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 
    86          IF( nn_hls == 1 ) THEN   ;   llsend1(:) = .false.   ;   llrecv1(:) = .false.   ;   END IF 
     93         IF( nn_hls == 1 ) THEN   ;   llsend1(:) = .false.   ;   llrecv1(:) = .false.   ;   ENDIF 
    8794         DO ib_bdy=1, nb_bdy 
    88             SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 
     95            SELECT CASE( cn_tra(ib_bdy) ) 
    8996            CASE('neumann') 
    9097               llsend1(:) = llsend1(:) .OR. lsend_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points 
     
    97104         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    98105            CALL lbc_lnk( 'trcbdy', tr(:,:,:,:,Krhs), 'T',  1.0_wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    99          END IF 
     106         ENDIF 
    100107         ! 
    101108      END DO   ! ir 
Note: See TracChangeset for help on using the changeset viewer.