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 14403 for NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE – NEMO

Ignore:
Timestamp:
2021-02-05T13:13:14+01:00 (3 years ago)
Author:
smasson
Message:

dev_r14312_MPI_Interface: merge with trunk@14402, #2598

Location:
NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/ICB/icbdia.F90

    r10570 r14403  
    8686   INTEGER                       ::  nbergs_start, nbergs_end, nbergs_calved 
    8787   INTEGER                       ::  nbergs_melted 
    88    INTEGER                       ::  nspeeding_tickets 
     88   INTEGER                       ::  nspeeding_tickets, nspeeding_tickets_all 
    8989   INTEGER , DIMENSION(nclasses) ::  nbergs_calved_by_class 
    9090 
    … …  
    125125      nbergs_calved_by_class(:) = 0 
    126126      nspeeding_tickets         = 0 
     127      nspeeding_tickets_all     = 0 
    127128      stored_heat_end           = 0._wp 
    128129      floating_heat_end         = 0._wp 
    … …  
    271272            CALL mpp_sum( 'icbdia', nsumbuf(1:nclasses+4), nclasses+4 ) 
    272273            ! 
    273             nbergs_end        = nsumbuf(1) 
    274             nbergs_calved     = nsumbuf(2) 
    275             nbergs_melted     = nsumbuf(3) 
    276             nspeeding_tickets = nsumbuf(4) 
     274            nbergs_end            = nsumbuf(1) 
     275            nbergs_calved         = nsumbuf(2) 
     276            nbergs_melted         = nsumbuf(3) 
     277            nspeeding_tickets_all = nsumbuf(4) 
    277278            DO ik = 1,nclasses 
    278279               nbergs_calved_by_class(ik)= nsumbuf(4+ik) 
    … …  
    329330         IF (nn_verbose_level > 0) THEN 
    330331            WRITE( numicb, '("calved by class = ",i6,20(",",i6))') (nbergs_calved_by_class(ik),ik=1,nclasses) 
    331             IF( nspeeding_tickets > 0 )   WRITE( numicb, '("speeding tickets issued = ",i6)') nspeeding_tickets 
     332            IF( nspeeding_tickets_all > 0 ) THEN 
     333                WRITE( numicb, '("speeding tickets issued (this domain)  = ",i6)') nspeeding_tickets 
     334                WRITE( numicb, '("speeding tickets issued (all domains)  = ",i6)') nspeeding_tickets_all 
     335            END IF 
    332336         ENDIF 
    333337         ! 
    … …  
    338342         nbergs_calved_by_class(:) = 0 
    339343         nspeeding_tickets         = 0 
     344         nspeeding_tickets_all     = 0 
    340345         stored_heat_start         = stored_heat_end 
    341346         floating_heat_start       = floating_heat_end 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/ICB/icbdyn.F90

    r14030 r14403  
    8585 
    8686         !                                         !**   A1 = A(X1,V1) 
    87          CALL icb_accel( berg , zxi1, ze1, zuvel1, zuvel1, zax1,     & 
    88             &                   zyj1, ze2, zvvel1, zvvel1, zay1, zdt_2 ) 
     87         CALL icb_accel( kt, berg , zxi1, ze1, zuvel1, zuvel1, zax1,     & 
     88            &                   zyj1, ze2, zvvel1, zvvel1, zay1, zdt_2, 0.5_wp ) 
    8989         ! 
    9090         zu1 = zuvel1 / ze1                           !**   V1 in d(i,j)/dt 
    … …  
    102102 
    103103         !                                         !**   A2 = A(X2,V2) 
    104          CALL icb_accel( berg , zxi2, ze1, zuvel2, zuvel1, zax2,    & 
    105             &                   zyj2, ze2, zvvel2, zvvel1, zay2, zdt_2 ) 
     104         CALL icb_accel( kt, berg , zxi2, ze1, zuvel2, zuvel1, zax2,    & 
     105            &                   zyj2, ze2, zvvel2, zvvel1, zay2, zdt_2, 0.5_wp ) 
    106106         ! 
    107107         zu2 = zuvel2 / ze1                           !**   V2 in d(i,j)/dt 
    … …  
    114114         zyj3  = zyj1  + zdt_2 * zv2   ;   zvvel3 = zvvel1 + zdt_2 * zay2 
    115115         ! 
    116          CALL icb_ground( berg, zxi3, zxi1, zu3,   & 
    117             &                   zyj3, zyj1, zv3, ll_bounced ) 
     116         CALL icb_ground( berg, zxi3, zxi1, zu2,   & 
     117            &                   zyj3, zyj1, zv2, ll_bounced ) 
    118118 
    119119         !                                         !**   A3 = A(X3,V3) 
    120          CALL icb_accel( berg , zxi3, ze1, zuvel3, zuvel1, zax3,    & 
    121             &                   zyj3, ze2, zvvel3, zvvel1, zay3, zdt ) 
     120         CALL icb_accel( kt, berg , zxi3, ze1, zuvel3, zuvel1, zax3,    & 
     121            &                   zyj3, ze2, zvvel3, zvvel1, zay3, zdt, 1._wp ) 
    122122         ! 
    123123         zu3 = zuvel3 / ze1                           !**   V3 in d(i,j)/dt 
    … …  
    130130         zyj4 = zyj1 + zdt * zv3   ;   zvvel4 = zvvel1 + zdt * zay3 
    131131 
    132          CALL icb_ground( berg, zxi4, zxi1, zu4,   & 
    133             &                   zyj4, zyj1, zv4, ll_bounced ) 
     132         CALL icb_ground( berg, zxi4, zxi1, zu3,   & 
     133            &                   zyj4, zyj1, zv3, ll_bounced ) 
    134134 
    135135         !                                         !**   A4 = A(X4,V4) 
    136          CALL icb_accel( berg , zxi4, ze1, zuvel4, zuvel1, zax4,    & 
    137             &                   zyj4, ze2, zvvel4, zvvel1, zay4, zdt ) 
     136         CALL icb_accel( kt, berg , zxi4, ze1, zuvel4, zuvel1, zax4,    & 
     137            &                   zyj4, ze2, zvvel4, zvvel1, zay4, zdt, 1._wp ) 
    138138 
    139139         zu4 = zuvel4 / ze1                           !**   V4 in d(i,j)/dt 
    … …  
    255255 
    256256 
    257    SUBROUTINE icb_accel( berg , pxi, pe1, puvel, puvel0, pax,                & 
    258       &                         pyj, pe2, pvvel, pvvel0, pay, pdt ) 
     257   SUBROUTINE icb_accel( kt, berg , pxi, pe1, puvel, puvel0, pax,                 & 
     258      &                             pyj, pe2, pvvel, pvvel0, pay, pdt, pcfl_scale ) 
    259259      !!---------------------------------------------------------------------- 
    260260      !!                  ***  ROUTINE icb_accel  *** 
    … …  
    265265      !!---------------------------------------------------------------------- 
    266266      TYPE(iceberg ), POINTER, INTENT(in   ) ::   berg             ! berg 
     267      INTEGER                , INTENT(in   ) ::   kt               ! time step 
     268      REAL(wp)               , INTENT(in   ) ::   pcfl_scale 
    267269      REAL(wp)               , INTENT(in   ) ::   pxi   , pyj      ! berg position in (i,j) referential 
    268270      REAL(wp)               , INTENT(in   ) ::   puvel , pvvel    ! berg velocity [m/s] 
    … …  
    404406         zspeed = SQRT( zuveln*zuveln + zvveln*zvveln )    ! Speed of berg 
    405407         IF( zspeed > 0._wp ) THEN 
    406             zloc_dx = MIN( pe1, pe2 )                          ! minimum grid spacing 
    407             zspeed_new = zloc_dx / pdt * rn_speed_limit        ! Speed limit as a factor of dx / dt 
     408            zloc_dx = MIN( pe1, pe2 )                                ! minimum grid spacing 
     409            ! cfl scale is function of the RK4 step 
     410            zspeed_new = zloc_dx / pdt * rn_speed_limit * pcfl_scale ! Speed limit as a factor of dx / dt 
    408411            IF( zspeed_new < zspeed ) THEN 
    409                zuveln = zuveln * ( zspeed_new / zspeed )        ! Scale velocity to reduce speed 
    410                zvveln = zvveln * ( zspeed_new / zspeed )        ! without changing the direction 
     412               zuveln = zuveln * ( zspeed_new / zspeed )             ! Scale velocity to reduce speed 
     413               zvveln = zvveln * ( zspeed_new / zspeed )             ! without changing the direction 
     414               pax = (zuveln - puvel0)/pdt 
     415               pay = (zvveln - pvvel0)/pdt 
     416               ! 
     417               ! print speeding ticket 
     418               IF (nn_verbose_level > 0) THEN 
     419                  WRITE(numicb, 9200) 'icb speeding : ',kt, nknberg, zspeed, & 
     420                       &                pxi, pyj, zuo, zvo, zua, zva, zui, zvi 
     421                  9200 FORMAT(a,i9,i6,f9.2,1x,4(1x,2f9.2)) 
     422               END IF 
     423               ! 
    411424               CALL icb_dia_speed() 
    412425            ENDIF 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/ICB/icbutl.F90

    r14118 r14403  
    320320         ! 
    321321         IF ( ierr > 0 ) THEN 
    322             WRITE(numout,*) 'bottom left corner T point out of bound' 
    323             WRITE(numout,*) pi, kii, mig( 1 ), mig(jpi) 
    324             WRITE(numout,*) pj, kij, mjg( 1 ), mjg(jpj) 
    325             WRITE(numout,*) pmsk 
    326             CALL ctl_stop('STOP','icb_utl_bilin_h: an icebergs coordinates is out of valid range (out of bound error)') 
     322            WRITE(numicb,*) 'bottom left corner T point out of bound' 
     323            WRITE(numicb,*) pi, kii, mig( 1 ), mig(jpi) 
     324            WRITE(numicb,*) pj, kij, mjg( 1 ), mjg(jpj) 
     325            WRITE(numicb,*) pmsk 
     326            CALL FLUSH(numicb) 
     327            CALL ctl_stop('STOP','icb_utl_bilin_e: an icebergs coordinates is out of valid range (out of bound error).'       , & 
     328                 &                                'This can be fixed using rn_speed_limit=0.4 in &namberg.'                   , & 
     329                 &                                'More details in the corresponding iceberg.stat file (nn_verbose_level > 0).' ) 
    327330         END IF 
    328331      END IF 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lib_mpp.F90

    r14363 r14403  
    13251325         END DO 
    13261326         IF ( crname_lbc(n_sequence_lbc) /= 'already counted' ) THEN 
    1327             WRITE(numcom,'(A, I4, A, A)') ' - ', 1,' times by subroutine ', TRIM(crname_lbc(ncom_rec_max)) 
     1327            WRITE(numcom,'(A, I4, A, A)') ' - ', 1,' times by subroutine ', TRIM(crname_lbc(n_sequence_lbc)) 
    13281328         END IF 
    13291329         WRITE(numcom,*) ' ' 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/SBC/sbcblk.F90

    r14363 r14403  
    4040   USE sbcdcy         ! surface boundary condition: diurnal cycle 
    4141   USE sbcwave , ONLY :   cdn_wave ! wave module 
    42    USE lib_fortran    ! to use key_nosignedzero 
     42   USE lib_fortran    ! to use key_nosignedzero and glob_sum 
    4343   ! 
    4444#if defined key_si3 
    … …  
    348348      !                                      !- fill the bulk structure with namelist informations 
    349349      CALL fld_fill( sf, slf_i, cn_dir, 'sbc_blk_init', 'surface boundary condition -- bulk formulae', 'namsbc_blk' ) 
     350      sf(jp_wndi )%zsgn = -1._wp   ;   sf(jp_wndj )%zsgn = -1._wp   ! vector field at T point: overwrite default definition of zsgn 
     351      sf(jp_uoatm)%zsgn = -1._wp   ;   sf(jp_voatm)%zsgn = -1._wp   ! vector field at T point: overwrite default definition of zsgn 
     352      sf(jp_hpgi )%zsgn = -1._wp   ;   sf(jp_hpgj )%zsgn = -1._wp   ! vector field at T point: overwrite default definition of zsgn 
    350353      ! 
    351354      DO jfpr= 1, jpfld 
    … …  
    509512      ! Sanity/consistence test on humidity at first time step to detect potential screw-up: 
    510513      IF( kt == nit000 ) THEN 
    511          IF(lwp) WRITE(numout,*) '' 
    512 #if defined key_agrif 
    513          IF(lwp) WRITE(numout,*) ' === AGRIF => Sanity/consistence test on air humidity SKIPPED! :( ===' 
    514 #else 
    515          ztst = SUM(tmask(:,:,1)) ! number of ocean points on local proc domain 
    516          IF( ztst > 8._wp ) THEN ! test only on proc domains with at least 8 ocean points! 
    517             ztst = SUM(sf(jp_humi)%fnow(:,:,1)*tmask(:,:,1))/ztst ! mean humidity over ocean on proc 
    518             llerr = .FALSE. 
    519             SELECT CASE( nhumi ) 
    520             CASE( np_humi_sph ) ! specific humidity => expect: 0. <= something < 0.065 [kg/kg] (0.061 is saturation at 45degC !!!) 
    521                IF( (ztst <   0._wp) .OR. (ztst > 0.065_wp) )   llerr = .TRUE. 
    522             CASE( np_humi_dpt ) ! dew-point temperature => expect: 110. <= something < 320. [K] 
    523                IF( (ztst < 110._wp) .OR. (ztst >  320._wp) )   llerr = .TRUE. 
    524             CASE( np_humi_rlh ) ! relative humidity => expect: 0. <= something < 100. [%] 
    525                IF( (ztst <   0._wp) .OR. (ztst >  100._wp) )   llerr = .TRUE. 
    526             END SELECT 
    527             IF(llerr) THEN 
    528                WRITE(ctmp1,'("   Error on mean humidity value: ",f10.5)') ztst 
    529                CALL ctl_stop( 'STOP', ctmp1, 'Something is wrong with air humidity!!!', & 
    530                   &   ' ==> check the unit in your input files'       , & 
    531                   &   ' ==> check consistence of namelist choice: specific? relative? dew-point?', & 
    532                   &   ' ==> ln_humi_sph -> [kg/kg] | ln_humi_rlh -> [%] | ln_humi_dpt -> [K] !!!' ) 
    533             END IF 
    534          END IF 
    535          IF(lwp) WRITE(numout,*) ' === Sanity/consistence test on air humidity sucessfuly passed! ===' 
    536 #endif 
    537          IF(lwp) WRITE(numout,*) '' 
    538       END IF !IF( kt == nit000 ) 
     514         ! mean humidity over ocean on proc 
     515         ztst = glob_sum( 'sbcblk', sf(jp_humi)%fnow(:,:,1) * e1e2t(:,:) * tmask(:,:,1) ) / glob_sum( 'sbcblk', e1e2t(:,:) * tmask(:,:,1) ) 
     516         llerr = .FALSE. 
     517         SELECT CASE( nhumi ) 
     518         CASE( np_humi_sph ) ! specific humidity => expect: 0. <= something < 0.065 [kg/kg] (0.061 is saturation at 45degC !!!) 
     519            IF( (ztst <   0._wp) .OR. (ztst > 0.065_wp) )   llerr = .TRUE. 
     520         CASE( np_humi_dpt ) ! dew-point temperature => expect: 110. <= something < 320. [K] 
     521            IF( (ztst < 110._wp) .OR. (ztst >  320._wp) )   llerr = .TRUE. 
     522         CASE( np_humi_rlh ) ! relative humidity => expect: 0. <= something < 100. [%] 
     523            IF( (ztst <   0._wp) .OR. (ztst >  100._wp) )   llerr = .TRUE. 
     524         END SELECT 
     525         IF(llerr) THEN 
     526            WRITE(ctmp1,'("   Error on mean humidity value: ",f10.5)') ztst 
     527            CALL ctl_stop( 'STOP', ctmp1, 'Something is wrong with air humidity!!!', & 
     528               &   ' ==> check the unit in your input files'       , & 
     529               &   ' ==> check consistence of namelist choice: specific? relative? dew-point?', & 
     530               &   ' ==> ln_humi_sph -> [kg/kg] | ln_humi_rlh -> [%] | ln_humi_dpt -> [K] !!!' ) 
     531         ENDIF 
     532         IF(lwp) THEN 
     533            WRITE(numout,*) '' 
     534            WRITE(numout,*) ' Global mean humidity at kt = nit000: ', ztst 
     535            WRITE(numout,*) ' === Sanity/consistence test on air humidity sucessfuly passed! ===' 
     536            WRITE(numout,*) '' 
     537         ENDIF 
     538      ENDIF   !IF( kt == nit000 ) 
    539539      !                                            ! compute the surface ocean fluxes using bulk formulea 
    540540      IF( MOD( kt - 1, nn_fsbc ) == 0 ) THEN 
    … …  
    622622      !!--------------------------------------------------------------------- 
    623623      INTEGER , INTENT(in   )                 ::   kt     ! time step index 
    624       REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pwndi  ! atmospheric wind at U-point              [m/s] 
    625       REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pwndj  ! atmospheric wind at V-point              [m/s] 
     624      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pwndi  ! atmospheric wind at T-point              [m/s] 
     625      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pwndj  ! atmospheric wind at T-point              [m/s] 
    626626      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   pqair  ! specific humidity at T-points            [kg/kg] 
    627627      REAL(wp), INTENT(in   ), DIMENSION(:,:) ::   ptair  ! potential temperature at T-points        [Kelvin] 
    … …  
    832832 
    833833         IF( ln_crt_fbk ) THEN 
    834             CALL lbc_lnk( 'sbcblk', utau, 'U', -1., vtau, 'V', -1., taum, 'T', -1. ) 
     834            CALL lbc_lnk( 'sbcblk', utau, 'U', -1._wp, vtau, 'V', -1._wp, taum, 'T', 1._wp ) 
    835835         ELSE 
    836             CALL lbc_lnk( 'sbcblk', utau, 'U', -1., vtau, 'V', -1. ) 
     836            CALL lbc_lnk( 'sbcblk', utau, 'U', -1._wp, vtau, 'V', -1._wp ) 
    837837         ENDIF 
    838838 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/SBC/sbcflx.F90

    r14338 r14403  
    119119         !                                         ! fill sf with slf_i and control print 
    120120         CALL fld_fill( sf, slf_i, cn_dir, 'sbc_flx', 'flux formulation for ocean surface boundary condition', 'namsbc_flx' ) 
     121         sf(jp_utau)%cltype = 'U'   ;   sf(jp_utau)%zsgn = -1._wp   ! vector field at U point: overwrite default definition of cltype and zsgn 
     122         sf(jp_vtau)%cltype = 'V'   ;   sf(jp_vtau)%zsgn = -1._wp   ! vector field at V point: overwrite default definition of cltype and zsgn 
    121123         ! 
    122124      ENDIF 
    … …  
    129131            qsr(:,:) = sbc_dcy( sf(jp_qsr)%fnow(:,:,1) ) * tmask(:,:,1) 
    130132         ELSE 
    131             DO_2D( 0, 0, 0, 0 ) 
    132                qsr(ji,jj) =          sf(jp_qsr)%fnow(ji,jj,1)  * tmask(ji,jj,1) 
     133            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     134               qsr(ji,jj) =     sf(jp_qsr)%fnow(ji,jj,1) * tmask(ji,jj,1) 
    133135            END_2D 
    134136         ENDIF 
    135          DO_2D( 0, 0, 0, 0 )                                      ! set the ocean fluxes from read fields 
     137         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )                  ! set the ocean fluxes from read fields 
    136138            utau(ji,jj) =   sf(jp_utau)%fnow(ji,jj,1)                              * umask(ji,jj,1) 
    137139            vtau(ji,jj) =   sf(jp_vtau)%fnow(ji,jj,1)                              * vmask(ji,jj,1) 
    … …  
    143145         !!clem: I do not think it is needed 
    144146         !!qns(:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp        ! mass flux is at SST 
    145          ! 
    146          ! clem: without these lbc calls, it seems that the northfold is not ok (true in 3.6, not sure in 4.x) 
    147          CALL lbc_lnk( 'sbcflx', utau, 'U', -1._wp, vtau, 'V', -1._wp, & 
    148             &                           qns, 'T',  1._wp, emp , 'T',  1._wp, qsr, 'T', 1._wp ) !! sfx, 'T', 1._wp  ) 
    149147         ! 
    150148         IF( nitend-nit000 <= 100 .AND. lwp ) THEN                ! control print (if less than 100 time-step asked) 

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/SBC/sbcwave.F90

    r14338 r14403  
    503503               ! 
    504504               CALL fld_fill( sf_sd, slf_i, cn_dir, 'sbc_wave_init', 'Wave module ', 'namsbc_wave' ) 
     505               sf_sd(jp_usd)%zsgn = -1._wp   ;  sf_sd(jp_vsd)%zsgn = -1._wp   ! vector field at T point: overwrite default definition of zsgn 
    505506            ENDIF 
    506507            ! 
Note: See TracChangeset for help on using the changeset viewer.