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 11082 for NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/BDY – NEMO

Ignore:
Timestamp:
2019-06-06T16:21:52+02:00 (5 years ago)
Author:
davestorkey
Message:

UKMO/NEMO_4.0_GO8_package : update to be relative to 11081 of NEMO_4.0_mirror.

Location:
NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/BDY
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/BDY/bdy_oce.F90

    r10888 r11082  
    8585   ! 
    8686   INTEGER                    ::   nb_bdy                   !: number of open boundary sets 
    87    INTEGER                    ::   nb_jpk_bdy               !: number of levels in the bdy data (set < 0 if consistent with planned run) 
     87   INTEGER, DIMENSION(jp_bdy) ::   nb_jpk_bdy               !: number of levels in the bdy data (set < 0 if consistent with planned run) 
    8888   INTEGER, DIMENSION(jp_bdy) ::   nn_rimwidth              !: boundary rim width for Flow Relaxation Scheme 
    8989   INTEGER                    ::   nn_volctl                !: = 0 the total volume will have the variability of the surface Flux E-P  
  • NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/BDY/bdydta.F90

    r10888 r11082  
    243243                        IF( ln_full_vel_array(jbdy) ) THEN 
    244244                           CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend),  & 
    245                                      & kit=jit, kt_offset=time_offset , jpk_bdy=nb_jpk_bdy,   & 
     245                                     & kit=jit, kt_offset=time_offset , jpk_bdy=nb_jpk_bdy(jbdy),   & 
    246246                                     & fvl=ln_full_vel_array(jbdy)  ) 
    247247                        ELSE 
     
    313313                     jend = jstart + dta%nread(1) - 1 
    314314                     CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 
    315                                   & map=nbmap_ptr(jstart:jend), kt_offset=time_offset, jpk_bdy=nb_jpk_bdy,   & 
     315                                  & map=nbmap_ptr(jstart:jend), kt_offset=time_offset, jpk_bdy=nb_jpk_bdy(jbdy),   & 
    316316                                  & fvl=ln_full_vel_array(jbdy) ) 
    317317                  ENDIF 
     
    446446      NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s 
    447447#endif 
    448       NAMELIST/nambdy_dta/ ln_full_vel, nb_jpk_bdy 
     448      NAMELIST/nambdy_dta/ ln_full_vel 
    449449      !!--------------------------------------------------------------------------- 
    450450      ! 
     
    508508      ! Read namelists 
    509509      ! -------------- 
    510       REWIND(numnam_ref) 
    511510      REWIND(numnam_cfg) 
    512511      jfld = 0  
    513512      DO jbdy = 1, nb_bdy          
    514513         IF( nn_dta(jbdy) == 1 ) THEN 
     514            REWIND(numnam_ref) 
    515515            READ  ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 
    516516901         IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp ) 
  • NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/BDY/bdydyn2d.F90

    r10888 r11082  
    187187         ! Use characteristics method instead 
    188188         zflag = ABS(flagu) 
    189          zforc = dta%u2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pua2d(iim1,ij) 
     189         zforc = dta%u2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pua2d(ii+NINT(flagu),ij) 
    190190         pua2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * umask(ii,ij,1)  
    191191      END DO 
     
    205205         ! Use characteristics method instead 
    206206         zflag = ABS(flagv) 
    207          zforc  = dta%v2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pva2d(ii,ijm1) 
     207         zforc  = dta%v2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pva2d(ii,ij+NINT(flagv)) 
    208208         pva2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * vmask(ii,ij,1) 
    209209      END DO 
  • NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/BDY/bdyice.F90

    r10888 r11082  
    5757      INTEGER ::   jbdy   ! BDY set index 
    5858      !!---------------------------------------------------------------------- 
    59       ! 
    60       IF( ln_timing )   CALL timing_start('bdy_ice_thd') 
     59      ! controls 
     60      IF( ln_timing    )   CALL timing_start('bdy_ice_thd')                                                            ! timing 
     61      IF( ln_icediachk )   CALL ice_cons_hsm(0,'bdy_ice_thd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
    6162      ! 
    6263      CALL ice_var_glo2eqv 
     
    7879      CALL ice_var_agg(1) 
    7980      ! 
    80       IF( ln_icectl )   CALL ice_prt( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' ) 
    81       IF( ln_timing )   CALL timing_stop('bdy_ice_thd') 
     81      ! controls 
     82      IF( ln_icediachk )   CALL ice_cons_hsm(1,'bdy_ice_thd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
     83      IF( ln_icectl    )   CALL ice_prt     ( kt, iiceprt, jiceprt, 1, ' - ice thermo bdy - ' )                        ! prints 
     84      IF( ln_timing    )   CALL timing_stop ('bdy_ice_thd')                                                            ! timing 
    8285      ! 
    8386   END SUBROUTINE bdy_ice 
     
    148151            jpbound = 0   ;   ib = ji   ;   jb = jj 
    149152            ! 
    150             IF( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. )   jpbound = 1 ; ib = ji+1 ; jb = jj 
    151             IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. )   jpbound = 1 ; ib = ji-1 ; jb = jj 
    152             IF( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. )   jpbound = 1 ; ib = ji  ; jb = jj+1 
    153             IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. )   jpbound = 1 ; ib = ji  ; jb = jj-1 
     153            IF( u_ice(ji  ,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. )   jpbound = 1 ; ib = ji+1 
     154            IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji  ,jj  ,1) == 0. )   jpbound = 1 ; ib = ji-1 
     155            IF( v_ice(ji  ,jj  ) < 0. .AND. vmask(ji  ,jj-1,1) == 0. )   jpbound = 1 ; jb = jj+1 
     156            IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj  ,1) == 0. )   jpbound = 1 ; jb = jj-1 
    154157            ! 
    155158            IF( nn_ice_dta(jbdy) == 0 )   jpbound = 0 ; ib = ji ; jb = jj   ! case ice boundaries = initial conditions 
     
    306309                     ! one of the two zmsk is always 0 (because of zflag) 
    307310                     zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji+1,jj) ) ) ! 0 if no ice 
    308                      zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji-1,jj) ) ) ! 0 if no ice 
     311                     zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj) ) )  ! 0 if no ice 
    309312                     !   
    310313                     ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then do not change u_ice) 
     
    329332                     ! one of the two zmsk is always 0 (because of zflag) 
    330333                     zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj+1) ) ) ! 0 if no ice 
    331                      zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj-1) ) ) ! 0 if no ice 
     334                     zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj) ) )  ! 0 if no ice 
    332335                     !   
    333336                     ! v_ice = v_ice of the adjacent grid point except if this grid point is ice-free (then do not change v_ice) 
  • NEMO/branches/UKMO/NEMO_4.0_GO8_package/src/OCE/BDY/bdyini.F90

    r10888 r11082  
    140140      INTEGER, ALLOCATABLE, DIMENSION(:,:,:)  ::   nbrdta           ! Discrete distance from rim points 
    141141      CHARACTER(LEN=1),DIMENSION(jpbgrd)      ::   cgrid 
    142       INTEGER :: com_east, com_west, com_south, com_north          ! Flags for boundaries sending 
     142      INTEGER :: com_east, com_west, com_south, com_north, jpk_max  ! Flags for boundaries sending 
    143143      INTEGER :: com_east_b, com_west_b, com_south_b, com_north_b  ! Flags for boundaries receiving 
    144144      INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4)                ! Arrays for neighbours coordinates 
     
    397397          IF(lwp) WRITE(numout,*) 
    398398        ENDIF 
    399         IF( nb_jpk_bdy > 0 ) THEN 
     399        IF( nb_jpk_bdy(ib_bdy) > 0 ) THEN 
    400400           IF(lwp) WRITE(numout,*) '*** open boundary will be interpolate in the vertical onto the native grid ***' 
    401401        ELSE 
     
    516516         ALLOCATE( nbidta(jpbdta, jpbgrd, nb_bdy), nbjdta(jpbdta, jpbgrd, nb_bdy),    & 
    517517            &      nbrdta(jpbdta, jpbgrd, nb_bdy) ) 
    518  
    519          IF( nb_jpk_bdy>0 ) THEN 
    520             ALLOCATE( dta_global(jpbdtau, 1, nb_jpk_bdy) ) 
    521             ALLOCATE( dta_global_z(jpbdtau, 1, nb_jpk_bdy) ) 
    522             ALLOCATE( dta_global_dz(jpbdtau, 1, nb_jpk_bdy) ) 
    523          ELSE 
    524             ALLOCATE( dta_global(jpbdtau, 1, jpk) ) 
    525             ALLOCATE( dta_global_z(jpbdtau, 1, jpk) ) ! needed ?? TODO 
    526             ALLOCATE( dta_global_dz(jpbdtau, 1, jpk) )! needed ?? TODO 
    527          ENDIF 
     518          
     519         jpk_max = MAXVAL(nb_jpk_bdy) 
     520         jpk_max = MAX(jpk_max, jpk) 
     521 
     522         ALLOCATE( dta_global(jpbdtau, 1, jpk_max) ) 
     523         ALLOCATE( dta_global_z(jpbdtau, 1, jpk_max) ) ! needed ?? TODO 
     524         ALLOCATE( dta_global_dz(jpbdtau, 1, jpk_max) )! needed ?? TODO 
    528525 
    529526         IF ( icount>0 ) THEN 
    530             IF( nb_jpk_bdy>0 ) THEN 
    531                ALLOCATE( dta_global2(jpbdtas, nrimmax, nb_jpk_bdy) ) 
    532                ALLOCATE( dta_global2_z(jpbdtas, nrimmax, nb_jpk_bdy) ) 
    533                ALLOCATE( dta_global2_dz(jpbdtas, nrimmax, nb_jpk_bdy) ) 
    534             ELSE 
    535                ALLOCATE( dta_global2(jpbdtas, nrimmax, jpk) ) 
    536                ALLOCATE( dta_global2_z(jpbdtas, nrimmax, jpk) ) ! needed ?? TODO 
    537                ALLOCATE( dta_global2_dz(jpbdtas, nrimmax, jpk) )! needed ?? TODO   
    538             ENDIF 
     527            ALLOCATE( dta_global2(jpbdtas, nrimmax, jpk_max) ) 
     528            ALLOCATE( dta_global2_z(jpbdtas, nrimmax, jpk_max) ) ! needed ?? TODO 
     529            ALLOCATE( dta_global2_dz(jpbdtas, nrimmax, jpk_max) )! needed ?? TODO   
    539530         ENDIF 
    540531         !  
     
    960951                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    961952                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2 
    962                        if((com_west_b .ne. 1) .and. (ii == (nlcit(nowe+1)-1))) then 
     953                       if( ii == (nlcit(nowe+1)-1) ) then 
    963954                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2 
    964955                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 
     
    974965                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    975966                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2 
    976                        if((com_east_b .ne. 1) .and. (ii == 2)) then 
     967                       if( ii == 2 ) then 
    977968                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2 
    978969                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 
     
    989980                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    990981                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(1)+2 
    991                        if((com_west_b .ne. 1) .and. (ii == (nlcit(nowe+1)-1))) then 
     982                       if( ii == (nlcit(nowe+1)-1) ) then 
    992983                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(1)+2 
    993984                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 
     
    1004995                       & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    1005996                       ii = nbidta(ib,igrd,ib_bdy)- iw_b(2)+2 
    1006                        if((com_east_b .ne. 1) .and. (ii == 2)) then 
     997                       if( ii == 2 ) then 
    1007998                          ij = nbjdta(ib,igrd,ib_bdy) - is_b(2)+2 
    1008999                          if((ij == 2) .and. (nbondj == 0 .or. nbondj == 1)) then 
Note: See TracChangeset for help on using the changeset viewer.