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 15432 – NEMO

Changeset 15432


Ignore:
Timestamp:
2021-10-21T21:36:24+02:00 (10 months ago)
Author:
jcastill
Message:

Reverting the changes in USR as they are now included in the CO9 branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/UKMO/r14075_India_uncoupled/src/OCE/USR/usrdef_sbc.F90

    r15422 r15432  
    11MODULE usrdef_sbc 
    22   !!====================================================================== 
    3    !!                       ***  MODULE usrdef_sbc  ***  
    4    !!   
    5    !!                  ===  AMM7_SURGE configuration  === 
     3   !!                     ***  MODULE  usrdef_sbc  *** 
     4   !! 
     5   !!                     ===  GYRE configuration  === 
    66   !! 
    77   !! User defined :   surface forcing of a user configuration 
    88   !!====================================================================== 
    99   !! History :  4.0   ! 2016-03  (S. Flavoni, G. Madec)  user defined interface 
    10    !!            4.0   ! 2017-12  (C. O'Neill)  add necessary options for surge work - either no fluxes   
    11    !!                                           (for tide-only run) or wind and pressure only 
    12    !!---------------------------------------------------------------------- 
    13  
    14    !!---------------------------------------------------------------------- 
    15    !!   usrdef_sbc    : user defined surface bounday conditions in LOCK_EXCHANGE case 
    16    !!---------------------------------------------------------------------- 
    17    USE oce             ! ocean dynamics and tracers  
    18    USE dom_oce         ! ocean space and time domain  
    19    USE sbc_oce         ! Surface boundary condition: ocean fields  
    20    USE sbc_ice         ! Surface boundary condition: ocean fields  
    21    USE fldread         ! read input fields  
    22    USE phycst          ! physical constants  
    23    USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
     10   !!---------------------------------------------------------------------- 
     11 
     12   !!---------------------------------------------------------------------- 
     13   !!   usrdef_sbc    : user defined surface bounday conditions in GYRE case 
     14   !!---------------------------------------------------------------------- 
     15   USE oce            ! ocean dynamics and tracers 
     16   USE dom_oce        ! ocean space and time domain 
     17   USE sbc_oce        ! Surface boundary condition: ocean fields 
     18   USE phycst         ! physical constants 
    2419   ! 
    25    USE in_out_manager  ! I/O manager  
    26    USE iom  
    27    USE lbclnk          ! ocean lateral boundary conditions (or mpp link)  
    28    USE lib_mpp         ! distribued memory computing library  
    29    !USE wrk_nemo       ! work arrays  
    30    USE timing         ! Timing  
    31    USE prtctl         ! Print control 
     20   USE in_out_manager ! I/O manager 
     21   USE lib_mpp        ! distribued memory computing library 
     22   USE lbclnk         ! ocean lateral boundary conditions (or mpp link) 
     23   USE lib_fortran    ! 
    3224 
    3325   IMPLICIT NONE 
    3426   PRIVATE 
    3527 
    36    PUBLIC   usrdef_sbc_oce    ! routine called in sbcmod module  
    37    PUBLIC   usrdef_sbc_ice_tau  ! routine called by sbcice_lim.F90 for ice dynamics  
    38    PUBLIC   usrdef_sbc_ice_flx  ! routine called by sbcice_lim.F90 for ice thermo  
    39    !                                  !!* Namelist namsbc_usr  
    40    REAL(wp) ::   rn_vfac     ! multiplication factor for ice/ocean velocity in the calculation of wind stress (clem)  
    41    REAL(wp) ::   rn_charn_const   
    42    LOGICAL  ::   ln_use_sbc  ! Surface fluxes on or not 
     28   PUBLIC   usrdef_sbc_oce       ! routine called in sbcmod module 
     29   PUBLIC   usrdef_sbc_ice_tau   ! routine called by icestp.F90 for ice dynamics 
     30   PUBLIC   usrdef_sbc_ice_flx   ! routine called by icestp.F90 for ice thermo 
    4331 
    4432   !! * Substitutions 
     
    5543      !!                    ***  ROUTINE usrdef_sbc  *** 
    5644      !!               
    57       !! ** Purpose :   provide at each time-step the surface boundary 
     45      !! ** Purpose :   provide at each time-step the GYRE surface boundary 
    5846      !!              condition, i.e. the momentum, heat and freshwater fluxes. 
    5947      !! 
    60       !! ** Method  :   all 0 fields, for AMM7_SURGE case 
     48      !! ** Method  :   analytical seasonal cycle for GYRE configuration. 
    6149      !!                CAUTION : never mask the surface stress field ! 
    6250      !! 
    63       !! ** Action  : - if tide-only case - set to ZERO all the ocean surface boundary condition, i.e. 
     51      !! ** Action  : - set the ocean surface boundary condition, i.e.    
    6452      !!                   utau, vtau, taum, wndm, qns, qsr, emp, sfx 
    65       !!              - if tide+surge case - read in wind and air pressure      !! 
     53      !! 
     54      !! Reference : Hazeleger, W., and S. Drijfhout, JPO, 30, 677-695, 2000. 
    6655      !!---------------------------------------------------------------------- 
    6756      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    68  
    69       INTEGER  ::   ios      ! Local integer output status for namelist read  
    70       !  
    71       CHARACTER(len=100) ::  cn_dir   !   Root directory for location of flux files  
    72       TYPE(FLD_N) ::   sn_wndi, sn_wndj                        ! informations about the fields to be read  
    73  
    74       NAMELIST/namsbc_usr/ ln_use_sbc, cn_dir , rn_vfac,  &  
    75          &                   sn_wndi, sn_wndj, rn_charn_const 
     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 
    7676      !!--------------------------------------------------------------------- 
    77       !  
    78       IF( kt == nit000 ) THEN  
    79            
    80            
    81          REWIND( numnam_cfg )              ! Namelist namsbc_usr in configuration namelist  
    82          READ  ( numnam_cfg, namsbc_usr, IOSTAT = ios, ERR = 902 )  
    83 902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_surge in configuration namelist' ) 
    84  
    85          IF(lwm) WRITE( numond, namsbc_usr ) 
    86          IF(lwp) WRITE(numout,*)' usr_sbc : AMM7_SURGE tide only case: NO surface forcing'  
    87          IF(lwp) WRITE(numout,*)' ~~~~~~~~~~~   utau = vtau = taum = wndm = qns = qsr = emp = sfx = 0' 
    88  
    89          utau(:,:) = 0._wp  
    90          vtau(:,:) = 0._wp  
    91          taum(:,:) = 0._wp  
    92          wndm(:,:) = 0._wp  
    93          !  
    94          emp (:,:) = 0._wp  
    95          sfx (:,:) = 0._wp  
    96          qns (:,:) = 0._wp  
    97          qsr (:,:) = 0._wp  
    98          ! 
     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( 'usrdef_sbc', emp  (:,:)   )  
     135      zsurf   = GLOB_SUM( 'usrdef_sbc', 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_multi( 'usrdef_sbc', taum(:,:), 'T', 1. , 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 
    99223      ENDIF 
    100224      ! 
     
    107231 
    108232 
    109    SUBROUTINE usrdef_sbc_ice_flx( kt ) 
     233   SUBROUTINE usrdef_sbc_ice_flx( kt, phs, phi ) 
    110234      INTEGER, INTENT(in) ::   kt   ! ocean time step 
     235      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phs    ! snow thickness 
     236      REAL(wp), DIMENSION(:,:,:), INTENT(in)  ::   phi    ! ice thickness 
    111237   END SUBROUTINE usrdef_sbc_ice_flx 
    112238 
Note: See TracChangeset for help on using the changeset viewer.