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 15537 for NEMO/branches/UKMO/v15531_cpl-mslp-apr – NEMO

Ignore:
Timestamp:
2021-11-25T12:47:25+01:00 (2 years ago)
Author:
jcastill
Message:

Changes compatible with the ticket (not tested in this revision)

Location:
NEMO/branches/UKMO/v15531_cpl-mslp-apr/src/OCE
Files:
6 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/UKMO/v15531_cpl-mslp-apr/src/OCE/SBC/sbcapr.F90

    r14072 r15537  
    1616   USE fldread         ! read input fields 
    1717   USE in_out_manager  ! I/O manager 
    18    USE lib_fortran     ! distribued memory computing library 
     18   USE lib_fortran     ! distributed memory computing library 
    1919   USE iom             ! IOM library 
    2020   USE lib_mpp         ! MPP library 
    … …  
    2929   LOGICAL, PUBLIC ::   ln_apr_obc = .false.   !: inverse barometer added to OBC ssh data 
    3030   LOGICAL, PUBLIC ::   ln_ref_apr             !: ref. pressure: global mean Patm (F) or a constant (F) 
    31    REAL(wp)        ::   rn_pref                !  reference atmospheric pressure   [N/m2] 
     31   REAL(wp),PUBLIC ::   rn_pref                !  reference atmospheric pressure   [N/m2] 
    3232 
    3333   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   ssh_ib    ! Inverse barometer now    sea surface height   [m] 
    … …  
    3535   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   apr       ! atmospheric pressure at kt                 [N/m2] 
    3636 
    37    REAL(wp) ::   tarea                ! whole domain mean masked ocean surface 
    38    REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rho0) 
     37   REAL(wp), PUBLIC ::  tarea                  ! whole domain mean masked ocean surface 
     38   REAL(wp), PUBLIC ::  r1_grau                ! = 1.e0 / (grav * rho0) 
     39 
     40   LOGICAL, PUBLIC ::   cpl_mslp = .FALSE. ! Presure is passed via coupling 
    3941 
    4042   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_apr   ! structure of input fields (file informations, fields read) 
    … …  
    7577      IF(lwm) WRITE ( numond, namsbc_apr ) 
    7678      ! 
    77       ALLOCATE( sf_apr(1), STAT=ierror )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
    78       IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' ) 
    79       ! 
    80       CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' ) 
     79      IF( .NOT. cpl_mslp ) THEN 
     80         ALLOCATE( sf_apr(1), STAT=ierror )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
     81         IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' ) 
     82         ! 
     83         CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' ) 
    8184                                ALLOCATE( sf_apr(1)%fnow(jpi,jpj,1)   ) 
    82       IF( sn_apr%ln_tint )   ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) ) 
    83                              ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) ) 
    84                              ALLOCATE( apr (jpi,jpj) ) 
     85         IF( sn_apr%ln_tint )   ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) ) 
     86      ENDIF 
     87                                ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) ) 
     88                                ALLOCATE( apr (jpi,jpj) ) 
    8589      ! 
    8690      IF( lwp )THEN                                 !* control print 
    8791         WRITE(numout,*) 
    88          WRITE(numout,*) '   Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing' 
     92         IF( cpl_mslp ) THEN 
     93            WRITE(numout,*) '   Namelist namsbc_apr : Atmospheric Pressure as coupling field' 
     94         ELSE 
     95            WRITE(numout,*) '   Namelist namsbc_apr : Atmospheric Pressure as external forcing' 
     96         ENDIF 
    8997         WRITE(numout,*) '      ref. pressure: global mean Patm (T) or a constant (F)  ln_ref_apr = ', ln_ref_apr 
    9098      ENDIF 

  • NEMO/branches/UKMO/v15531_cpl-mslp-apr/src/OCE/SBC/sbccpl.F90

    r15004 r15537  
    220220#endif 
    221221 
    222    REAL(wp) ::   rpref = 101000._wp   ! reference atmospheric pressure[N/m2] 
    223    REAL(wp) ::   r1_grau              ! = 1.e0 / (grav * rho0) 
    224  
    225222   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   nrcvinfo           ! OASIS info argument 
    226223 
    … …  
    601598      !                                                      ! Mean Sea Level Pressure   ! 
    602599      !                                                      ! ------------------------- ! 
    603       srcv(jpr_mslp)%clname = 'O_MSLP'     ;   IF( TRIM(sn_rcv_mslp%cldes  ) == 'coupled' )    srcv(jpr_mslp)%laction = .TRUE. 
     600      srcv(jpr_mslp)%clname = 'O_MSLP' 
     601      IF( TRIM(sn_rcv_mslp%cldes  ) == 'coupled' ) THEN 
     602         srcv(jpr_mslp)%laction = .TRUE. 
     603         cpl_mslp = .TRUE. 
     604      ENDIF 
    604605      ! 
    605606      !                                                      ! --------------------------------- ! 
    … …  
    11751176      !!---------------------------------------------------------------------- 
    11761177      USE zdf_oce,  ONLY :   ln_zdfswm 
     1178      USE sbcssm ,  ONLY :   sbc_ssm_cpl    
     1179      USE lib_fortran     ! distributed memory computing library 
    11771180      ! 
    11781181      INTEGER, INTENT(in) ::   kt          ! ocean model time step index 
    … …  
    13481351      !                                                      ! ========================= ! 
    13491352      IF( srcv(jpr_mslp)%laction ) THEN                    ! UKMO SHELF effect of atmospheric pressure on SSH 
    1350           IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields 
    1351  
    1352           r1_grau = 1.e0 / (grav * rho0)               !* constant for optimization 
    1353           ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rpref ) * r1_grau    ! equivalent ssh (inverse barometer) 
    1354           apr   (:,:) =     frcv(jpr_mslp)%z3(:,:,1)                         !atmospheric pressure 
    1355  
    1356           IF( kt == nit000 ) ssh_ibb(:,:) = ssh_ib(:,:)  ! correct this later (read from restart if possible) 
     1353         IF( ln_apr_dyn ) THEN   
     1354            IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)     !* Swap of ssh_ib fields 
     1355               !                                  !* update the reference atmospheric pressure (if necessary)    
     1356               IF( ln_ref_apr )  rn_pref = glob_sum( 'sbccpl', frcv(jpr_mslp)%z3(:,:,1) * e1e2t(:,:) ) / tarea 
     1357        
     1358               ssh_ib(:,:) = - ( frcv(jpr_mslp)%z3(:,:,1) - rn_pref ) * r1_grau  ! equivalent ssh (inverse barometer)    
     1359               apr   (:,:) =     frcv(jpr_mslp)%z3(:,:,1)                        !atmospheric pressure    
     1360               !   
     1361               CALL iom_put( "ssh_ib", ssh_ib )   !* output the inverse barometer ssh   
     1362               !                                         ! ---------------------------------------- !    
     1363               IF( kt == nit000 ) THEN                   !   set the forcing field at nit000 - 1    !    
     1364                  !                                      ! ---------------------------------------- !    
     1365                  !* Restart: read in restart file    
     1366                  IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN    
     1367                     IF(lwp) WRITE(numout,*) 'sbc_cpl:   ssh_ibb read in the restart file'    
     1368                     CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb )   ! before inv. barometer ssh    
     1369                  ELSE                                         !* no restart: set from nit000 values    
     1370                     IF(lwp) WRITE(numout,*) 'sbc_cpl:   ssh_ibb set to nit000 values'    
     1371                     ssh_ibb(:,:) = ssh_ib(:,:)    
     1372                  ENDIF    
     1373               ENDIF    
     1374               !                                         ! ---------------------------------------- !    
     1375               IF( lrst_oce ) THEN                       !      Write in the ocean restart file     !    
     1376                  !                                      ! ---------------------------------------- !    
     1377                  IF(lwp) WRITE(numout,*)    
     1378                  IF(lwp) WRITE(numout,*) 'sbc_cpl : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp    
     1379                  IF(lwp) WRITE(numout,*) '~~~~'    
     1380                  CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib )    
     1381               ENDIF    
     1382            ENDIF   
     1383         
     1384            ! Update mean ssh    
     1385            IF( nn_components /= jp_iam_sas ) CALL sbc_ssm_cpl( kt ) 
     1386         ENDIF 
    13571387      ENDIF 
    13581388      ! 

  • NEMO/branches/UKMO/v15531_cpl-mslp-apr/src/OCE/SBC/sbcmod.F90

    r15372 r15537  
    370370      !!                utau_b, vtau_b, qns_b, qsr_b, emp_n, sfx_b, qrp_b, erp_b 
    371371      !!                utau  , vtau  , qns  , qsr  , emp  , sfx  , qrp  , erp 
    372       !!              - updte the ice fraction : fr_i 
     372      !!              - update the ice fraction : fr_i 
    373373      !!---------------------------------------------------------------------- 
     374      USE sbcapr, ONLY: sbc_apr, cpl_mslp   
     375      USE bdydta, ONLY: bdy_dta   
     376      ! 
    374377      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    375378      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
    … …  
    403406      !                                            !        forcing field computation         ! 
    404407      !                                            ! ---------------------------------------- ! 
     408      IF( ln_apr_dyn .AND. .NOT. cpl_mslp ) CALL sbc_apr( kt )   ! atmospheric pressure provided at kt+0.5*nn_fsbc   
     409                                                         ! (caution called before sbc_ssm) 
    405410      ! 
    406411      ll_sas = nn_components == jp_iam_sas               ! component flags 
    … …  
    435440      ! 
    436441      IF( ln_mixcpl )          CALL sbc_cpl_rcv   ( kt, nn_fsbc, nn_ice, Kbb, Kmm )  ! forced-coupled mixed formulation after forcing 
     442      ! 
     443      IF( ln_bdy )             CALL bdy_dta ( kt, kt_offset=+1 )                     ! update dynamic & tracer data at open boundaries 
    437444      ! 
    438445      IF( ln_wave .AND. ln_tauoc )  THEN            ! Wave stress reduction 

  • NEMO/branches/UKMO/v15531_cpl-mslp-apr/src/OCE/SBC/sbcssm.F90

    r15145 r15537  
    2828 
    2929   PUBLIC   sbc_ssm        ! routine called by step.F90 
     30   PUBLIC   sbc_ssm_cpl    ! routine called by sbccpl.F90 
    3031   PUBLIC   sbc_ssm_init   ! routine called by sbcmod.F90 
    3132 
    … …  
    7576         sss_m(:,:) = zts(:,:,jp_sal) 
    7677         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    77          IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh(:,:,Kmm) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    78          ELSE                    ;   ssh_m(:,:) = ssh(:,:,Kmm) 
     78         IF( .NOT. cpl_mslp ) THEN 
     79            IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh(:,:,Kmm) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     80            ELSE                    ;   ssh_m(:,:) = ssh(:,:,Kmm) 
     81            ENDIF 
    7982         ENDIF 
    8083         ! 
    … …  
    98101            sss_m(:,:) = zcoef * zts(:,:,jp_sal) 
    99102            !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    100             IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( ssh(:,:,Kmm) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
    101             ELSE                    ;   ssh_m(:,:) = zcoef *   ssh(:,:,Kmm) 
     103            IF( .NOT. cpl_mslp ) THEN 
     104               IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( ssh(:,:,Kmm) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
     105               ELSE                    ;   ssh_m(:,:) = zcoef *   ssh(:,:,Kmm) 
     106               ENDIF 
    102107            ENDIF 
    103108            ! 
    … …  
    112117            sst_m(:,:) = 0._wp 
    113118            sss_m(:,:) = 0._wp 
    114             ssh_m(:,:) = 0._wp 
     119            IF( .NOT. cpl_mslp ) ssh_m(:,:) = 0._wp 
    115120            e3t_m(:,:) = 0._wp 
    116121            frq_m(:,:) = 0._wp 
    … …  
    126131         sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal) 
    127132         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    128          IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + ssh(:,:,Kmm) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    129          ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + ssh(:,:,Kmm) 
     133         IF( .NOT. cpl_mslp ) THEN 
     134            IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + ssh(:,:,Kmm) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     135            ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + ssh(:,:,Kmm) 
     136            ENDIF 
    130137         ENDIF 
    131138         ! 
    … …  
    142149            ssu_m(:,:) = ssu_m(:,:) * zcoef     ! mean suface current  [m/s] 
    143150            ssv_m(:,:) = ssv_m(:,:) * zcoef     ! 
    144             ssh_m(:,:) = ssh_m(:,:) * zcoef     ! mean SSH             [m] 
     151            IF( .NOT. cpl_mslp ) ssh_m(:,:) = ssh_m(:,:) * zcoef     ! mean SSH             [m] 
    145152            e3t_m(:,:) = e3t_m(:,:) * zcoef     ! mean vertical scale factor [m] 
    146153            frq_m(:,:) = frq_m(:,:) * zcoef     ! mean fraction of solar net radiation absorbed in the 1st T level [-] 
    … …  
    160167            CALL iom_rstput( kt, nitrst, numrow, 'sst_m'  , sst_m  ) 
    161168            CALL iom_rstput( kt, nitrst, numrow, 'sss_m'  , sss_m  ) 
    162             CALL iom_rstput( kt, nitrst, numrow, 'ssh_m'  , ssh_m  ) 
     169            IF( .NOT. cpl_mslp ) CALL iom_rstput( kt, nitrst, numrow, 'ssh_m'  , ssh_m  ) 
    163170            CALL iom_rstput( kt, nitrst, numrow, 'e3t_m'  , e3t_m  ) 
    164171            CALL iom_rstput( kt, nitrst, numrow, 'frq_m'  , frq_m  ) 
    … …  
    180187   END SUBROUTINE sbc_ssm 
    181188 
     189   SUBROUTINE sbc_ssm_cpl( kt )    
     190      !!---------------------------------------------------------------------    
     191      !!                   ***  ROUTINE sbc_ssm_cpl  ***    
     192      !!                         
     193      !! ** Purpose :   provide ocean surface variable to sea-surface boundary    
     194      !!                condition computation when pressure is read from coupling    
     195      !!                    
     196      !! ** Method  :   The inverse barometer ssh (i.e. ssh associated with Patm)    
     197      !!                is added to ssh_m when ln_apr_dyn = T. Required for sea-ice dynamics.    
     198      !!---------------------------------------------------------------------    
     199      INTEGER, INTENT(in) ::   kt   ! ocean time step    
     200      !    
     201      REAL(wp) ::   zcoef       ! local scalar    
     202      !!---------------------------------------------------------------------    
     203      !    
     204      IF( nn_fsbc == 1 ) THEN                             !      Instantaneous surface fields        !    
     205         !                                                ! ---------------------------------------- !    
     206         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )    
     207         ELSE                    ;   ssh_m(:,:) = sshn(:,:)    
     208         ENDIF    
     209      ELSE    
     210         !                                                ! ----------------------------------------------- !    
     211         IF( kt == nit000 .AND. .NOT. l_ssm_mean ) THEN   !  Initialisation: 1st time-step, no input means  !    
     212            !                                             ! ----------------------------------------------- !    
     213            IF(lwp) WRITE(numout,*)    
     214            IF(lwp) WRITE(numout,*) '~~~~~~~   mean ssh field initialised to instantaneous values'    
     215            zcoef = REAL( nn_fsbc - 1, wp )    
     216            zcoef = REAL( nn_fsbc - 1, wp )    
     217            IF( ln_apr_dyn ) THEN    ;  ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) )    
     218            ELSE                     ;  ssh_m(:,:) = zcoef * sshn(:,:)    
     219            ENDIF    
     220            !                                             ! ---------------------------------------- !    
     221         ELSEIF( MOD( kt - 2 , nn_fsbc ) == 0 ) THEN      !   Initialisation: New mean computation   !    
     222            !                                             ! ---------------------------------------- !    
     223            ssh_m(:,:) = 0.e0    
     224         ENDIF    
     225      
     226         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )    
     227         ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:)    
     228         ENDIF    
     229         !                                                ! ---------------------------------------- !    
     230         IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN          !   Mean value at each nn_fsbc time-step   !    
     231            !                                             ! ---------------------------------------- !    
     232            zcoef = 1. / REAL( nn_fsbc, wp )    
     233            ssh_m(:,:) = ssh_m(:,:) * zcoef           ! mean SSH [m]    
     234         ENDIF    
     235         !                                                ! ---------------------------------------- !    
     236         IF( lrst_oce ) THEN                              !      Write in the ocean restart file     !    
     237            !                                             ! ---------------------------------------- !    
     238            IF(lwp) WRITE(numout,*)    
     239            IF(lwp) WRITE(numout,*) 'sbc_ssm_cpl : ssh mean field written in ocean restart file ',   &    
     240               &                    'at it= ', kt,' date= ', ndastp    
     241            IF(lwp) WRITE(numout,*) '~~~~~~~'    
     242            CALL iom_rstput( kt, nitrst, numrow, 'ssh_m'  , ssh_m  )    
     243         ENDIF    
     244      ENDIF    
     245      !    
     246      IF( MOD( kt - 1 , nn_fsbc ) == 0 ) THEN          !   Mean value at each nn_fsbc time-step   !    
     247         CALL iom_put( 'ssh_m', ssh_m )    
     248      ENDIF    
     249      !    
     250   END SUBROUTINE sbc_ssm_cpl 
    182251 
    183252   SUBROUTINE sbc_ssm_init( Kbb, Kmm ) 

  • NEMO/branches/UKMO/v15531_cpl-mslp-apr/src/OCE/step.F90

    r15398 r15537  
    153153      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    154154      IF( ln_tide    )   CALL tide_update( kstp )                     ! update tide potential 
    155       IF( ln_apr_dyn )   CALL sbc_apr ( kstp )                        ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib) 
    156       IF( ln_bdy     )   CALL bdy_dta ( kstp, Nnn )                   ! update dynamic & tracer data at open boundaries 
    157155      IF( ln_isf     )   CALL isf_stp ( kstp, Nnn ) 
    158156                         CALL sbc     ( kstp, Nbb, Nnn )              ! Sea Boundary Condition (including sea-ice) 

  • NEMO/branches/UKMO/v15531_cpl-mslp-apr/src/OCE/stpmlf.F90

    r15398 r15537  
    160160      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    161161      IF( ln_tide    )   CALL tide_update( kstp )                     ! update tide potential 
    162       IF( ln_apr_dyn )   CALL sbc_apr ( kstp )                        ! atmospheric pressure (NB: call before bdy_dta which needs ssh_ib) 
    163       IF( ln_bdy     )   CALL bdy_dta ( kstp, Nnn )                   ! update dynamic & tracer data at open boundaries 
    164162      IF( ln_isf     )   CALL isf_stp ( kstp, Nnn ) 
    165163                         CALL sbc     ( kstp, Nbb, Nnn )              ! Sea Boundary Condition (including sea-ice) 
Note: See TracChangeset for help on using the changeset viewer.