Changeset 11080


Ignore:
Timestamp:
2019-06-06T15:32:24+02:00 (17 months ago)
Author:
jcastill
Message:

Latest changes from Jason

Location:
branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r10684 r11080  
    759759      ENDDO 
    760760 
     761      DO jfld = 1, nb_bdy_fld_sum 
     762         bf(jfld)%igrd = igrid(jfld) 
     763         bf(jfld)%ibdy = ibdy(jfld) 
     764      ENDDO 
     765 
    761766      ! Initialise local boundary data arrays 
    762767      ! nn_xxx_dta=0 : allocate space - will be filled from initial conditions later 
  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r10684 r11080  
    3131   USE dynadv         ! dynamics: vector invariant versus flux form 
    3232   USE dynspg_ts      ! surface pressure gradient: split-explicit scheme 
     33   USE dynspg 
    3334   USE domvvl         ! variable volume 
    3435   USE bdy_oce   , ONLY: ln_bdy 
     
    179180            vn(:,:,jk) = va(:,:,jk) 
    180181         END DO 
     182         ! limit velocities 
     183         IF (ln_ulimit) THEN 
     184            call dyn_limit_velocity (kt) 
     185         ENDIF 
    181186         IF(.NOT.ln_linssh ) THEN 
    182187            DO jk = 1, jpkm1 
     
    203208               END DO 
    204209            END DO 
     210            ! limit velocities 
     211            IF (ln_ulimit) THEN 
     212               call dyn_limit_velocity (kt) 
     213            ENDIF 
    205214            !                             ! ================! 
    206215         ELSE                             ! Variable volume ! 
     
    250259                  END DO 
    251260               END DO 
     261               ! limit velocities 
     262               IF (ln_ulimit) THEN 
     263                  call dyn_limit_velocity (kt) 
     264               ENDIF 
    252265               ! 
    253266            ELSE                          ! Asselin filter applied on thickness weighted velocity 
     
    277290                  END DO 
    278291               END DO 
     292               ! limit velocities 
     293               IF (ln_ulimit) THEN 
     294                  call dyn_limit_velocity (kt) 
     295               ENDIF 
    279296               e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)        ! e3u_b <-- filtered scale factor 
    280297               e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 
     
    353370   END SUBROUTINE dyn_nxt 
    354371 
     372   SUBROUTINE dyn_limit_velocity (kt) 
     373      ! limits maxming vlaues of un and vn by volume courant number 
     374      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     375      ! 
     376      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     377      REAL(wp) :: zzu,zplim,zmlim,isp,ism,zcn,ze3e1,zzcn,zcnn,idivp,idivm 
     378 
     379      ! limit fluxes 
     380      zcn =cn_ulimit !0.9 ! maximum velocity inverse courant number 
     381      zcnn = cnn_ulimit !0.54 ! how much to reduce cn by in divergen flow 
     382 
     383      DO jk = 1, jpkm1 
     384         DO jj = 1, jpjm1 
     385            DO ji = 1, jpim1 
     386               ! U direction 
     387               zzu = un(ji,jj,jk) 
     388               ze3e1 = e3u_n(ji  ,jj,jk) * e2u(ji  ,jj) 
     389               ! ips is 1 if flow is positive othersize zero 
     390               isp =  0.5 * (sign(1.0_wp,zzu) + 1.0_wp ) 
     391               ism = -0.5 * (sign(1.0_wp,zzu) - 1.0_wp ) 
     392               ! idev is 1 if divergent flow otherwise zero 
     393               idivp = -isp * 0.5 * (sign(1.0_wp, un(ji-1,jj,jk)) - 1.0_wp ) 
     394               idivm =  ism * 0.5 * (sign(1.0_wp, un(ji+1,jj,jk)) + 1.0_wp ) 
     395               zzcn = (idivp+idivm)*(zcnn-1.0_wp)+1.0_wp 
     396               zzcn = zzcn * zcn 
     397               zplim =  zzcn * (e3t_n(ji  ,jj,jk) * e1t(ji  ,jj) * e2t(ji  ,jj)) / & 
     398                                               (2.0*rdt * ze3e1)*umask(ji,jj,jk) 
     399               zmlim = -zzcn * (e3t_n(ji+1,jj,jk) * e1t(ji+1,jj) * e2t(ji+1,jj)) / & 
     400                                               (2.0*rdt * ze3e1)*umask(ji,jj,jk) 
     401               ! limit currents 
     402               un(ji,jj,jk) = min ( zzu,zplim) * isp + max (zzu,zmlim) *ism 
     403               ! V  direction 
     404               zzu = vn(ji,jj,jk) 
     405               ze3e1 = e3v_n(ji  ,jj,jk) * e1v(ji  ,jj) 
     406               isp =  0.5 * (sign(1.0_wp,zzu) + 1.0_wp ) 
     407               ism = -0.5 * (sign(1.0_wp,zzu) - 1.0_wp ) 
     408               ! idev is 1 if divergent flow otherwise zero 
     409               idivp = -isp * 0.5 * (sign(1.0_wp, vn(ji,jj-1,jk)) - 1.0_wp ) 
     410               idivm =  ism * 0.5 * (sign(1.0_wp, vn(ji,jj+1,jk)) + 1.0_wp ) 
     411               zzcn = (idivp+idivm)*(zcnn-1.0_wp)+1.0_wp 
     412               zzcn = zzcn * zcn 
     413               zplim =  zzcn * (e3t_n(ji,jj  ,jk) * e1t(ji,jj  ) * e2t(ji,jj  )) / & 
     414                                               (2.0*rdt * ze3e1)*vmask(ji,jj,jk) 
     415               zmlim = -zzcn * (e3t_n(ji,jj+1,jk) * e1t(ji,jj+1) * e2t(ji,jj+1)) / & 
     416                                               (2.0*rdt * ze3e1)*vmask(ji,jj,jk) 
     417               vn(ji,jj,jk) = min ( zzu,zplim) * isp + max (zzu,zmlim) *ism 
     418            ENDDO 
     419         ENDDO 
     420      ENDDO 
     421 
     422    END SUBROUTINE dyn_limit_velocity 
     423 
    355424   !!========================================================================= 
    356425END MODULE dynnxt 
  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90

    r10684 r11080  
    3939   INTEGER ::   nspg = 0   ! type of surface pressure gradient scheme defined from lk_dynspg_...  
    4040 
     41   LOGICAL, PUBLIC ::  ln_ulimit 
     42   REAL(wp), PUBLIC :: cn_ulimit,cnn_ulimit 
     43 
    4144   !                       ! Parameter to control the surface pressure gradient scheme 
    4245   INTEGER, PARAMETER ::   np_TS  = 1   ! split-explicit time stepping (Time-Splitting) 
     
    183186      NAMELIST/namdyn_spg/ ln_dynspg_exp       , ln_dynspg_ts,   & 
    184187      &                    ln_bt_fw, ln_bt_av  , ln_bt_auto  ,   & 
    185       &                    nn_baro , rn_bt_cmax, nn_bt_flt 
     188      &                    nn_baro , rn_bt_cmax, nn_bt_flt   ,   & 
     189                           ln_ulimit, cn_ulimit, cnn_ulimit 
    186190      !!---------------------------------------------------------------------- 
    187191      ! 
     
    203207         WRITE(numout,*) '     Explicit free surface                  ln_dynspg_exp = ', ln_dynspg_exp 
    204208         WRITE(numout,*) '     Free surface with time splitting       ln_dynspg_ts  = ', ln_dynspg_ts 
     209         WRITE(numout,*) '     Limit velocities                       ln_ulimit     = ', ln_ulimit 
     210         WRITE(numout,*) '     Limit velocities      max inverse Courant number     = ', cn_ulimit 
     211         WRITE(numout,*) '     Limit velocities   multiplier for divergant flow     = ', cnn_ulimit 
    205212      ENDIF 
    206213      !                          ! Control of surface pressure gradient scheme options 
  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r10684 r11080  
    810810               CALL iom_get ( num, jpdom_unknown, 'gdepv', dta_read_z(1:ilendta,1:ipj,1:jpk_bdy) ) 
    811811               CALL iom_get ( num, jpdom_unknown, 'e3v',  dta_read_dz(1:ilendta,1:ipj,1:jpk_bdy) ) 
     812            CASE DEFAULT ;   CALL ctl_stop( 'unrecognised value for igrd in fld_map' ) 
    812813         END SELECT 
    813814 
     
    909910                     WRITE(ibstr,"(I10.10)") map%ptr(ib)  
    910911                     CALL ctl_warn('fld_bdy_interp: U depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%') 
    911                      IF(lwp) WRITE(*,*) 'DEPTHU', zh, sum(e3u_n(zij,zjj,:), mask=umask(zij,zjj,:)==1),  sum(umask(zij,zjj,:)), & 
    912                        &                hu_n(zij,zjj), map%ptr(ib), ib, zij, zjj, narea-1  , & 
    913                         &                dta_read(map%ptr(ib),1,:) 
     912                     !IF(lwp) WRITE(*,*) 'DEPTHU', zh, sum(e3u_n(zij,zjj,:), mask=umask(zij,zjj,:)==1),  sum(umask(zij,zjj,:)), & 
     913                     !  &                hu_n(zij,zjj), map%ptr(ib), ib, zij, zjj, narea-1  , & 
     914                     !   &                dta_read(map%ptr(ib),1,:) 
    914915                  ENDIF 
    915916               CASE(3) 
  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_istate.F90

    r10684 r11080  
    6262         DO jj = 1, jpj 
    6363            DO ji = 1, jpi 
    64                pts(ji,jj,jk,jp_tem) =  (  (  16. - 12. * TANH( (pdept(ji,jj,jk) - 400) / 700 ) )   & 
    65                     &           * (-TANH( (500. - pdept(ji,jj,jk)) / 150. ) + 1.) / 2.             & 
    66                     &           + ( 15. * ( 1. - TANH( (pdept(ji,jj,jk)-50.) / 1500.) )            & 
    67                     &           - 1.4 * TANH((pdept(ji,jj,jk)-100.) / 100.)                        & 
    68                     &           + 7.  * (1500. - pdept(ji,jj,jk) ) / 1500.)                        & 
    69                     &           * (-TANH( (pdept(ji,jj,jk) - 500.) / 150.) + 1.) / 2.  ) * ptmask(ji,jj,jk) 
    70  
    71                pts(ji,jj,jk,jp_sal) =  (  (  36.25 - 1.13 * TANH( (pdept(ji,jj,jk) - 305) / 460 ) )  & 
    72                     &         * (-TANH((500. - pdept(ji,jj,jk)) / 150.) + 1.) / 2                  & 
    73                     &         + ( 35.55 + 1.25 * (5000. - pdept(ji,jj,jk)) / 5000.                 & 
    74                     &         - 1.62 * TANH( (pdept(ji,jj,jk) - 60.  ) / 650. )                    & 
    75                     &         + 0.2  * TANH( (pdept(ji,jj,jk) - 35.  ) / 100. )                    & 
    76                     &         + 0.2  * TANH( (pdept(ji,jj,jk) - 1000.) / 5000.) )                  & 
    77                     &         * (-TANH( (pdept(ji,jj,jk) - 500.) / 150.) + 1.) / 2  ) * ptmask(ji,jj,jk) 
     64               pts(ji,jj,jk,jp_tem) = 20._wp * ptmask(ji,jj,jk) 
     65               pts(ji,jj,jk,jp_sal) = 36.25_wp * ptmask(ji,jj,jk) 
    7866            END DO 
    7967         END DO 
  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/USR/usrdef_sbc.F90

    r7753 r11080  
    11MODULE usrdef_sbc 
    22   !!====================================================================== 
    3    !!                     ***  MODULE usrdef_sbc  *** 
    4    !! 
    5    !!                     ===  GYRE configuration  === 
     3   !!                       ***  MODULE usrdef_sbc  *** 
     4   !!  
     5   !!                  ===  WAD_TEST_CASES configuration  === 
    66   !! 
    77   !! User defined :   surface forcing of a user configuration 
     
    1111 
    1212   !!---------------------------------------------------------------------- 
    13    !!   usrdef_sbc    : user defined surface bounday conditions in GYRE case 
     13   !!   usrdef_sbc     : user defined surface bounday conditions in WAD_TEST_CASES case 
    1414   !!---------------------------------------------------------------------- 
    1515   USE oce             ! ocean dynamics and tracers 
     
    2121   USE lib_mpp         ! distribued memory computing library 
    2222   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    23    USE lib_fortran     ! 
     23   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)  
    2424 
    2525   IMPLICIT NONE 
     
    4141   SUBROUTINE usrdef_sbc_oce( kt ) 
    4242      !!--------------------------------------------------------------------- 
    43       !!                    ***  ROUTINE usrdef_sbc  *** 
     43      !!                    ***  ROUTINE usr_def_sbc  *** 
    4444      !!               
    45       !! ** Purpose :   provide at each time-step the GYRE surface boundary 
     45      !! ** Purpose :   provide at each time-step the surface boundary 
    4646      !!              condition, i.e. the momentum, heat and freshwater fluxes. 
    4747      !! 
    48       !! ** Method  :   analytical seasonal cycle for GYRE configuration. 
     48      !! ** Method  :   all 0 fields, for WAD_TEST_CASES case 
    4949      !!                CAUTION : never mask the surface stress field ! 
    5050      !! 
    51       !! ** Action  : - set the ocean surface boundary condition, i.e.    
     51      !! ** Action  : - set to ZERO all the ocean surface boundary condition, i.e.    
    5252      !!                   utau, vtau, taum, wndm, qns, qsr, emp, sfx 
    5353      !! 
    54       !! Reference : Hazeleger, W., and S. Drijfhout, JPO, 30, 677-695, 2000. 
    5554      !!---------------------------------------------------------------------- 
    5655      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    57       !! 
    58       INTEGER  ::   ji, jj                 ! dummy loop indices 
    59       INTEGER  ::   zyear0                 ! initial year  
    60       INTEGER  ::   zmonth0                ! initial month 
    61       INTEGER  ::   zday0                  ! initial day 
    62       INTEGER  ::   zday_year0             ! initial day since january 1st 
    63       REAL(wp) ::   ztau     , ztau_sais   ! wind intensity and of the seasonal cycle 
    64       REAL(wp) ::   ztime                  ! time in hour 
    65       REAL(wp) ::   ztimemax , ztimemin    ! 21th June, and 21th decem. if date0 = 1st january 
    66       REAL(wp) ::   ztimemax1, ztimemin1   ! 21th June, and 21th decem. if date0 = 1st january 
    67       REAL(wp) ::   ztimemax2, ztimemin2   ! 21th June, and 21th decem. if date0 = 1st january 
    68       REAL(wp) ::   ztaun                  ! intensity 
    69       REAL(wp) ::   zemp_s, zemp_n, zemp_sais, ztstar 
    70       REAL(wp) ::   zcos_sais1, zcos_sais2, ztrp, zconv, t_star 
    71       REAL(wp) ::   zsumemp, zsurf 
    72       REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3 
    73       REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient 
    74       REAL(wp) ::   ztx, zty, zmod, zcoef ! temporary variables 
    75       REAL(wp) ::   zyydd                 ! number of days in one year 
    7656      !!--------------------------------------------------------------------- 
    77       zyydd = REAL(nyear_len(1),wp) 
    78  
    79       ! ---------------------------- ! 
    80       !  heat and freshwater fluxes  ! 
    81       ! ---------------------------- ! 
    82       !same temperature, E-P as in HAZELEGER 2000 
    83  
    84       zyear0     =   ndate0 / 10000                             ! initial year 
    85       zmonth0    = ( ndate0 - zyear0 * 10000 ) / 100            ! initial month 
    86       zday0      =   ndate0 - zyear0 * 10000 - zmonth0 * 100    ! initial day betwen 1 and 30 
    87       zday_year0 = ( zmonth0 - 1 ) * 30.+zday0                  ! initial day betwen 1 and 360 
    88  
    89       ! current day (in hours) since january the 1st of the current year 
    90       ztime = REAL( kt ) * rdt / (rmmss * rhhmm)   &       !  total incrementation (in hours) 
    91          &      - (nyear  - 1) * rjjhh * zyydd             !  minus years since beginning of experiment (in hours) 
    92  
    93       ztimemax1 = ((5.*30.)+21.)* 24.                      ! 21th june     at 24h in hours 
    94       ztimemin1 = ztimemax1 + rjjhh * zyydd / 2            ! 21th december        in hours 
    95       ztimemax2 = ((6.*30.)+21.)* 24.                      ! 21th july     at 24h in hours 
    96       ztimemin2 = ztimemax2 - rjjhh * zyydd / 2            ! 21th january         in hours 
    97       !                                                    ! NB: rjjhh * zyydd / 4 = one seasonal cycle in hours 
    98  
    99       ! amplitudes 
    100       zemp_S    = 0.7       ! intensity of COS in the South 
    101       zemp_N    = 0.8       ! intensity of COS in the North 
    102       zemp_sais = 0.1 
    103       zTstar    = 28.3      ! intemsity from 28.3 a -5 deg 
    104  
    105       ! 1/2 period between 21th June and 21th December and between 21th July and 21th January 
    106       zcos_sais1 = COS( (ztime - ztimemax1) / (ztimemin1 - ztimemax1) * rpi )  
    107       zcos_sais2 = COS( (ztime - ztimemax2) / (ztimemax2 - ztimemin2) * rpi ) 
    108  
    109       ztrp= - 40.e0        ! retroaction term on heat fluxes (W/m2/K) 
    110       zconv = 3.16e-5      ! convertion factor: 1 m/yr => 3.16e-5 mm/s 
    111       DO jj = 1, jpj 
    112          DO ji = 1, jpi 
    113             ! domain from 15 deg to 50 deg between 27 and 28  degC at 15N, -3 
    114             ! and 13 degC at 50N 53.5 + or - 11 = 1/4 period : 
    115             ! 64.5 in summer, 42.5 in winter 
    116             t_star = zTstar * ( 1. + 1. / 50. * zcos_sais2 )                & 
    117                &                    * COS( rpi * (gphit(ji,jj) - 5.)               & 
    118                &                    / ( 53.5 * ( 1 + 11 / 53.5 * zcos_sais2 ) * 2.) ) 
    119             ! 23.5 deg : tropics 
    120             qsr (ji,jj) =  230 * COS( 3.1415 * ( gphit(ji,jj) - 23.5 * zcos_sais1 ) / ( 0.9 * 180 ) ) 
    121             qns (ji,jj) = ztrp * ( tsb(ji,jj,1,jp_tem) - t_star ) - qsr(ji,jj) 
    122             IF( gphit(ji,jj) >= 14.845 .AND. 37.2 >= gphit(ji,jj) ) THEN    ! zero at 37.8 deg, max at 24.6 deg 
    123                emp  (ji,jj) =   zemp_S * zconv   & 
    124                   &         * SIN( rpi / 2 * (gphit(ji,jj) - 37.2) / (24.6 - 37.2) )  & 
    125                   &         * ( 1 - zemp_sais / zemp_S * zcos_sais1) 
    126             ELSE 
    127                emp (ji,jj) =  - zemp_N * zconv   & 
    128                   &         * SIN( rpi / 2 * (gphit(ji,jj) - 37.2) / (46.8 - 37.2) )  & 
    129                   &         * ( 1 - zemp_sais / zemp_N * zcos_sais1 ) 
    130             ENDIF 
    131          END DO 
    132       END DO 
    133  
    134       zsumemp = GLOB_SUM( emp  (:,:)   )  
    135       zsurf   = GLOB_SUM( tmask(:,:,1) )  
    136       zsumemp = zsumemp / zsurf         ! Default GYRE configuration 
    137  
    138       ! freshwater (mass flux) and update of qns with heat content of emp 
    139       emp (:,:) = emp(:,:) - zsumemp * tmask(:,:,1)        ! freshwater flux (=0 in domain average) 
    140       sfx (:,:) = 0.0_wp                                   ! no salt flux 
    141       qns (:,:) = qns(:,:) - emp(:,:) * sst_m(:,:) * rcp   ! evap and precip are at SST 
    142  
    143  
    144       ! ---------------------------- ! 
    145       !       momentum fluxes        ! 
    146       ! ---------------------------- ! 
    147       ! same wind as in Wico 
    148       !test date0 : ndate0 = 010203 
    149       zyear0  =   ndate0 / 10000 
    150       zmonth0 = ( ndate0 - zyear0 * 10000 ) / 100 
    151       zday0   =   ndate0 - zyear0 * 10000 - zmonth0 * 100 
    152       !Calculates nday_year, day since january 1st 
    153       zday_year0 = (zmonth0-1)*30.+zday0 
    154  
    155       !accumulates days of previous months of this year 
    156       ! day (in hours) since january the 1st 
    157       ztime = FLOAT( kt ) * rdt / (rmmss * rhhmm)  &  ! incrementation in hour 
    158          &     - (nyear - 1) * rjjhh * zyydd          !  - nber of hours the precedent years 
    159       ztimemax = ((5.*30.)+21.)* 24.               ! 21th june     in hours 
    160       ztimemin = ztimemax + rjjhh * zyydd / 2      ! 21th december in hours 
    161       !                                            ! NB: rjjhh * zyydd / 4 = 1 seasonal cycle in hours 
    162  
    163       ! mean intensity at 0.105 ; srqt(2) because projected with 45deg angle 
    164       ztau = 0.105 / SQRT( 2. ) 
    165       ! seasonal oscillation intensity 
    166       ztau_sais = 0.015 
    167       ztaun = ztau - ztau_sais * COS( (ztime - ztimemax) / (ztimemin - ztimemax) * rpi ) 
    168       DO jj = 1, jpj 
    169          DO ji = 1, jpi 
    170            ! domain from 15deg to 50deg and 1/2 period along 14deg 
    171            ! so 5/4 of half period with seasonal cycle 
    172            utau(ji,jj) = - ztaun * SIN( rpi * (gphiu(ji,jj) - 15.) / (29.-15.) ) 
    173            vtau(ji,jj) =   ztaun * SIN( rpi * (gphiv(ji,jj) - 15.) / (29.-15.) ) 
    174          END DO 
    175       END DO 
    176  
    177       ! module of wind stress and wind speed at T-point 
    178       zcoef = 1. / ( zrhoa * zcdrag )  
    179       DO jj = 2, jpjm1 
    180          DO ji = fs_2, fs_jpim1   ! vect. opt. 
    181             ztx = utau(ji-1,jj  ) + utau(ji,jj)  
    182             zty = vtau(ji  ,jj-1) + vtau(ji,jj)  
    183             zmod = 0.5 * SQRT( ztx * ztx + zty * zty ) 
    184             taum(ji,jj) = zmod 
    185             wndm(ji,jj) = SQRT( zmod * zcoef ) 
    186          END DO 
    187       END DO 
    188       CALL lbc_lnk( taum(:,:), 'T', 1. )   ;   CALL lbc_lnk( wndm(:,:), 'T', 1. ) 
    189  
    190       ! ---------------------------------- ! 
    191       !  control print at first time-step  ! 
    192       ! ---------------------------------- ! 
    193       IF( kt == nit000 .AND. lwp ) THEN  
    194          WRITE(numout,*) 
    195          WRITE(numout,*)'usrdef_sbc_oce : analytical surface fluxes for GYRE configuration'                
    196          WRITE(numout,*)'~~~~~~~~~~~ '  
    197          WRITE(numout,*)'           nyear      = ', nyear 
    198          WRITE(numout,*)'           nmonth     = ', nmonth 
    199          WRITE(numout,*)'           nday       = ', nday 
    200          WRITE(numout,*)'           nday_year  = ', nday_year 
    201          WRITE(numout,*)'           ztime      = ', ztime 
    202          WRITE(numout,*)'           ztimemax   = ', ztimemax 
    203          WRITE(numout,*)'           ztimemin   = ', ztimemin 
    204          WRITE(numout,*)'           ztimemax1  = ', ztimemax1 
    205          WRITE(numout,*)'           ztimemin1  = ', ztimemin1 
    206          WRITE(numout,*)'           ztimemax2  = ', ztimemax2 
    207          WRITE(numout,*)'           ztimemin2  = ', ztimemin2 
    208          WRITE(numout,*)'           zyear0     = ', zyear0 
    209          WRITE(numout,*)'           zmonth0    = ', zmonth0 
    210          WRITE(numout,*)'           zday0      = ', zday0 
    211          WRITE(numout,*)'           zday_year0 = ', zday_year0 
    212          WRITE(numout,*)'           zyydd      = ', zyydd 
    213          WRITE(numout,*)'           zemp_S     = ', zemp_S 
    214          WRITE(numout,*)'           zemp_N     = ', zemp_N 
    215          WRITE(numout,*)'           zemp_sais  = ', zemp_sais 
    216          WRITE(numout,*)'           zTstar     = ', zTstar 
    217          WRITE(numout,*)'           zsumemp    = ', zsumemp 
    218          WRITE(numout,*)'           zsurf      = ', zsurf 
    219          WRITE(numout,*)'           ztrp       = ', ztrp 
    220          WRITE(numout,*)'           zconv      = ', zconv 
    221          WRITE(numout,*)'           ndastp     = ', ndastp 
    222          WRITE(numout,*)'           adatrj     = ', adatrj 
     57      ! 
     58      IF( kt == nit000 ) THEN 
     59         ! 
     60         IF(lwp) WRITE(numout,*)' usr_sbc : WAD_TEST_CASES case: NO surface forcing' 
     61         IF(lwp) WRITE(numout,*)' ~~~~~~~~~~~   utau = vtau = taum = wndm = qns = qsr = emp = sfx = 0' 
     62         ! 
     63         utau(:,:) = 0._wp 
     64         vtau(:,:) = 0._wp 
     65         taum(:,:) = 0._wp 
     66         wndm(:,:) = 0._wp 
     67         ! 
     68         emp (:,:) = 0._wp 
     69         sfx (:,:) = 0._wp 
     70         qns (:,:) = 0._wp 
     71         qsr (:,:) = 0._wp 
     72         !          
    22373      ENDIF 
    22474      ! 
  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/stpctl.F90

    r10684 r11080  
    5252      INTEGER  ::   ji, jj, jk             ! dummy loop indices 
    5353      INTEGER  ::   ii, ij, ik             ! local integers 
    54       REAL(wp) ::   zumax, zsmin, zssh2, zsshmax    ! local scalars 
     54      REAL(wp) ::   velmax2, zsmin, zssh2, zsshmax    ! local scalars 
    5555      INTEGER, DIMENSION(3) ::   ilocu     !  
    5656      INTEGER, DIMENSION(2) ::   ilocs     !  
     
    7070      !                                              !* Test maximum of velocity (zonal only) 
    7171      !                                              !  ------------------------ 
    72       !! zumax = MAXVAL( ABS( un(:,:,:) ) )                ! slower than the following loop on NEC SX5 
    73       zumax = 0.e0 
     72      !! velmax2 = MAXVAL( ABS( un(:,:,:) ) )                ! slower than the following loop on NEC SX5 
     73      velmax2 = 0.e0 
    7474      DO jk = 1, jpk 
    7575         DO jj = 1, jpj 
    7676            DO ji = 1, jpi 
    77                zumax = MAX(zumax,ABS(un(ji,jj,jk))) 
     77               velmax2 = MAX( velmax2,un(ji,jj,jk)**2 + vn(ji,jj,jk)**2 ) 
    7878          END DO  
    7979        END DO  
    8080      END DO         
    81       IF( lk_mpp )   CALL mpp_max( zumax )                 ! max over the global domain 
     81      IF( lk_mpp )   CALL mpp_max( velmax2 )               ! max over the global domain 
    8282      ! 
    83       IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' abs(U) max: ', zumax 
     83      IF( MOD( kt, nwrite ) == 1 .AND. lwp )   WRITE(numout,*) ' ==>> time-step= ',kt,' 3d speed max: ', velmax2 
    8484      ! 
    85       IF( zumax > 20.e0 ) THEN 
     85      IF( velmax2 > 20.e0**2 ) THEN 
    8686         IF( lk_mpp ) THEN 
    87             CALL mpp_maxloc(ABS(un),umask,zumax,ii,ij,ik) 
     87            CALL mpp_maxloc( un(:,:,:)**2+vn(:,:,:)**2,umask,velmax2,ii,ij,ik) 
    8888         ELSE 
    89             ilocu = MAXLOC( ABS( un(:,:,:) ) ) 
     89            ilocu = MAXLOC( un(:,:,:)**2 + vn(:,:,:)**2 ) 
    9090            ii = ilocu(1) + nimpp - 1 
    9191            ij = ilocu(2) + njmpp - 1 
     
    9494         IF(lwp) THEN 
    9595            WRITE(numout,cform_err) 
    96             WRITE(numout,*) ' stpctl: the zonal velocity is larger than 20 m/s' 
     96            WRITE(numout,*) ' stpctl: the speed is larger than 20 m/s' 
    9797            WRITE(numout,*) ' ====== ' 
    98             WRITE(numout,9400) kt, zumax, ii, ij, ik 
     98            WRITE(numout,9400) kt, velmax2, ii, ij, ik 
    9999            WRITE(numout,*) 
    100100            WRITE(numout,*) '          output of last fields in numwso' 
     
    102102         kindic = -3 
    103103      ENDIF 
    104 9400  FORMAT (' kt=',i6,' max abs(U): ',1pg11.4,', i j k: ',3i5) 
     1049400  FORMAT (' kt=',i6,' max abs(vel)**2: ',1pg11.4,', i j k: ',3i5) 
    105105      ! 
    106106      !                                              !* Test minimum of salinity 
     
    180180      zssh2 = glob_sum( sshn(:,:) * sshn(:,:) ) 
    181181      ! 
    182       IF(lwp) WRITE(numsol,9700) kt, zssh2, zumax, zsmin      ! ssh statistics 
     182      IF(lwp) WRITE(numsol,9700) kt, zssh2, velmax2, zsmin      ! ssh statistics 
    183183      ! 
    184 9700  FORMAT(' it :', i8, ' ssh2: ', d23.16, ' Umax: ',d23.16,' Smin: ',d23.16) 
     1849700  FORMAT(' it :', i8, ' ssh2: ', d23.16, ' velmax2: ',d23.16,' SSSmin: ',d23.16) 
    185185      ! 
    186186   END SUBROUTINE stp_ctl 
Note: See TracChangeset for help on using the changeset viewer.