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

Changeset 8524


Ignore:
Timestamp:
2017-09-15T13:59:24+02:00 (7 years ago)
Author:
cbricaud
Message:

bugfix in trunk for ticket #1922

Location:
trunk/NEMOGCM/NEMO/OPA_SRC
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90

    r6140 r8524  
    2323   PRIVATE 
    2424 
    25    PUBLIC   sbc_apr    ! routine called in sbcmod 
     25   PUBLIC   sbc_apr       ! routine called in sbcmod 
     26   PUBLIC   sbc_apr_init  ! routine called in sbcmod 
    2627    
    2728   !                                !!* namsbc_apr namelist (Atmospheric PRessure) * 
     
    4647CONTAINS 
    4748 
     49   SUBROUTINE sbc_apr_init 
     50      !!--------------------------------------------------------------------- 
     51      !!                     ***  ROUTINE sbc_apr  *** 
     52      !! 
     53      !! ** Purpose :   read atmospheric pressure fields in netcdf files. 
     54      !! 
     55      !! ** Method  : - Read namelist namsbc_apr 
     56      !!              - Read Patm fields in netcdf files  
     57      !!              - Compute reference atmospheric pressure 
     58      !!              - Compute inverse barometer ssh 
     59      !! ** action  :   apr      : atmospheric pressure at kt 
     60      !!                ssh_ib   : inverse barometer ssh at kt 
     61      !!--------------------------------------------------------------------- 
     62      INTEGER            ::   ierror  ! local integer  
     63      INTEGER            ::   ios     ! Local integer output status for namelist read 
     64      !! 
     65      CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files 
     66      TYPE(FLD_N)        ::  sn_apr   ! informations about the fields to be read 
     67      !! 
     68      NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr, rn_pref, ln_apr_obc 
     69      !!---------------------------------------------------------------------- 
     70      REWIND( numnam_ref )              ! Namelist namsbc_apr in reference namelist : File for atmospheric pressure forcing 
     71      READ  ( numnam_ref, namsbc_apr, IOSTAT = ios, ERR = 901) 
     72901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in reference namelist', lwp ) 
     73 
     74      REWIND( numnam_cfg )              ! Namelist namsbc_apr in configuration namelist : File for atmospheric pressure forcing 
     75      READ  ( numnam_cfg, namsbc_apr, IOSTAT = ios, ERR = 902 ) 
     76902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in configuration namelist', lwp ) 
     77      IF(lwm) WRITE ( numond, namsbc_apr ) 
     78      ! 
     79      ALLOCATE( sf_apr(1), STAT=ierror )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
     80      IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' ) 
     81      ! 
     82      CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' ) 
     83                                ALLOCATE( sf_apr(1)%fnow(jpi,jpj,1)   ) 
     84      IF( sn_apr%ln_tint )   ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) ) 
     85                             ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) ) 
     86                             ALLOCATE( apr (jpi,jpj) ) 
     87      ! 
     88      IF( lwp )THEN                                 !* control print 
     89         WRITE(numout,*) 
     90         WRITE(numout,*) '   Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing' 
     91         WRITE(numout,*) '      ref. pressure: global mean Patm (T) or a constant (F)  ln_ref_apr = ', ln_ref_apr 
     92      ENDIF 
     93      ! 
     94      IF( ln_ref_apr ) THEN                        !* Compute whole inner domain mean masked ocean surface 
     95         tarea = glob_sum( e1e2t(:,:) ) 
     96         IF(lwp) WRITE(numout,*) '         Variable ref. Patm computed over a ocean surface of ', tarea*1e-6, 'km2' 
     97      ELSE 
     98         IF(lwp) WRITE(numout,*) '         Reference Patm used : ', rn_pref, ' N/m2' 
     99      ENDIF 
     100      ! 
     101      r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization 
     102      ! 
     103      !                                            !* control check 
     104      IF ( ln_apr_obc  ) THEN 
     105         IF(lwp) WRITE(numout,*) '         Inverse barometer added to OBC ssh data' 
     106      ENDIF 
     107!jc: stop below should rather be a warning  
     108      IF( ln_apr_obc .AND. .NOT.ln_apr_dyn   )   & 
     109            CALL ctl_warn( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' ) 
     110      ! 
     111   END SUBROUTINE sbc_apr_init 
     112 
    48113   SUBROUTINE sbc_apr( kt ) 
    49114      !!--------------------------------------------------------------------- 
     
    61126      INTEGER, INTENT(in)::   kt   ! ocean time step 
    62127      ! 
    63       INTEGER            ::   ierror  ! local integer  
    64       INTEGER            ::   ios     ! Local integer output status for namelist read 
    65       !! 
    66       CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files 
    67       TYPE(FLD_N)        ::  sn_apr   ! informations about the fields to be read 
    68       !! 
    69       NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr, rn_pref, ln_apr_obc 
    70128      !!---------------------------------------------------------------------- 
    71       ! 
    72       !                                         ! -------------------- ! 
    73       IF( kt == nit000 ) THEN                   ! First call kt=nit000 ! 
    74          !                                      ! -------------------- ! 
    75          REWIND( numnam_ref )              ! Namelist namsbc_apr in reference namelist : File for atmospheric pressure forcing 
    76          READ  ( numnam_ref, namsbc_apr, IOSTAT = ios, ERR = 901) 
    77 901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in reference namelist', lwp ) 
    78  
    79          REWIND( numnam_cfg )              ! Namelist namsbc_apr in configuration namelist : File for atmospheric pressure forcing 
    80          READ  ( numnam_cfg, namsbc_apr, IOSTAT = ios, ERR = 902 ) 
    81 902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_apr in configuration namelist', lwp ) 
    82          IF(lwm) WRITE ( numond, namsbc_apr ) 
    83          ! 
    84          ALLOCATE( sf_apr(1), STAT=ierror )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
    85          IF( ierror > 0 )   CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' ) 
    86          ! 
    87          CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' ) 
    88                                 ALLOCATE( sf_apr(1)%fnow(jpi,jpj,1)   ) 
    89          IF( sn_apr%ln_tint )   ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) ) 
    90                                 ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) ) 
    91                                 ALLOCATE( apr (jpi,jpj) ) 
    92          ! 
    93          IF(lwp) THEN                                 !* control print 
    94             WRITE(numout,*) 
    95             WRITE(numout,*) '   Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing' 
    96             WRITE(numout,*) '      ref. pressure: global mean Patm (T) or a constant (F)  ln_ref_apr = ', ln_ref_apr 
    97          ENDIF 
    98          ! 
    99          IF( ln_ref_apr ) THEN                        !* Compute whole inner domain mean masked ocean surface 
    100             tarea = glob_sum( e1e2t(:,:) ) 
    101             IF(lwp) WRITE(numout,*) '         Variable ref. Patm computed over a ocean surface of ', tarea*1e-6, 'km2' 
    102          ELSE 
    103             IF(lwp) WRITE(numout,*) '         Reference Patm used : ', rn_pref, ' N/m2' 
    104          ENDIF 
    105          ! 
    106          r1_grau = 1.e0 / (grav * rau0)               !* constant for optimization 
    107          ! 
    108          !                                            !* control check 
    109          IF ( ln_apr_obc  ) THEN 
    110             IF(lwp) WRITE(numout,*) '         Inverse barometer added to OBC ssh data' 
    111          ENDIF 
    112 !jc: stop below should rather be a warning  
    113          IF( ln_apr_obc .AND. .NOT.ln_apr_dyn   )   & 
    114             CALL ctl_stop( 'sbc_apr: use inverse barometer ssh at open boundary ONLY requires ln_apr_dyn=T' ) 
    115       ENDIF 
    116129 
    117130      !                                         ! ========================== ! 
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r7822 r8524  
    4141   USE sbcssr         ! surface boundary condition: sea surface restoring 
    4242   USE sbcrnf         ! surface boundary condition: runoffs 
     43   USE sbcapr         ! surface boundary condition: atmo pressure  
    4344   USE sbcisf         ! surface boundary condition: ice shelf 
    4445   USE sbcfwb         ! surface boundary condition: freshwater budget 
     
    332333                          CALL sbc_rnf_init            ! Runof initialization 
    333334      ! 
     335      IF( ln_apr_dyn )    CALL sbc_apr_init            ! Atmo Pressure Forcing initialization 
     336      ! 
    334337      IF( nn_ice == 3 )   CALL sbc_lim_init            ! LIM3 initialization 
    335338      ! 
  • trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r7761 r8524  
    452452      !                                      ! external forcing  
    453453!!gm to be added : creation and call of sbc_apr_init 
     454!==> cbr: sbc_apr_init in sbcmod as sbc_rnf_init 
    454455                            CALL    tide_init   ! tidal harmonics 
    455456                            CALL     sbc_init   ! surface boundary conditions (including sea-ice) 
Note: See TracChangeset for help on using the changeset viewer.