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 13094 for NEMO/branches/2020/ticket2377/src/OCE/SBC/sbcfwb.F90 – NEMO

Ignore:
Timestamp:
2020-06-10T20:28:00+02:00 (4 years ago)
Author:
smueller
Message:

Revision of the adjustment-flux initialisation in option 2 of the freshwater-budget adjustment mechanism (ticket #2377)

This changeset replaces the file-based initialisation of the freshwater-budget adjustment flux (input file EMPave_old.dat) with control of the initial flux adjustment through parameter rn_fwb0 of a new namelist namsbc_fwb. Further, it replaces the adjustment-flux output into a dedicated file (output file EMPave.dat) by the reporting of the final adjustment flux applied by the model in file ocean.output.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/ticket2377/src/OCE/SBC/sbcfwb.F90

    r13082 r13094  
    3535   PUBLIC   sbc_fwb    ! routine called by step 
    3636 
     37   REAL(wp) ::   rn_fwb0   ! initial freshwater adjustment flux [kg/m2/s] (nn_fwb = 2 only) 
    3738   REAL(wp) ::   a_fwb     ! annual domain averaged freshwater budget from the 
    3839                           ! previous year 
     
    6566      INTEGER, INTENT( in ) ::   Kmm      ! ocean time level index 
    6667      ! 
    67       INTEGER  ::   inum, ikty, iyear     ! local integers 
     68      INTEGER  ::   ios, inum, ikty       ! local integers 
    6869      REAL(wp) ::   z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp                ! local scalars 
    6970      REAL(wp) ::   zsurf_neg, zsurf_pos, zsurf_tospread, zcoef          !   -      - 
     
    7273      REAL(wp)   ,DIMENSION(1) ::   z_fwfprv   
    7374      COMPLEX(wp),DIMENSION(1) ::   y_fwfnow   
     75      ! 
     76      NAMELIST/namsbc_fwb/rn_fwb0 
    7477      !!---------------------------------------------------------------------- 
    7578      ! 
    7679      IF( kt == nit000 ) THEN 
     80         READ( numnam_ref, namsbc_fwb, IOSTAT = ios, ERR = 901 ) 
     81901      IF( ios /= 0 ) CALL ctl_nam( ios, 'namsbc_fwb in reference namelist'     ) 
     82         READ( numnam_cfg, namsbc_fwb, IOSTAT = ios, ERR = 902 ) 
     83902      IF( ios >  0 ) CALL ctl_nam( ios, 'namsbc_fwb in configuration namelist' ) 
     84         IF(lwm) WRITE( numond, namsbc_fwb ) 
    7785         IF(lwp) THEN 
    7886            WRITE(numout,*) 
     
    8088            WRITE(numout,*) '~~~~~~~' 
    8189            IF( kn_fwb == 1 )   WRITE(numout,*) '          instantaneously set to zero' 
    82             IF( kn_fwb == 2 )   WRITE(numout,*) '          adjusted from previous year budget' 
    8390            IF( kn_fwb == 3 )   WRITE(numout,*) '          fwf set to zero and spread out over erp area' 
     91            IF( kn_fwb == 2 ) THEN 
     92               WRITE(numout,*) '          adjusted from previous year budget' 
     93               WRITE(numout,*) 
     94               WRITE(numout,*) '   Namelist namsbc_fwb' 
     95               WRITE(numout,*) '      Initial freshwater adjustment flux [kg/m2/s] = ', rn_fwb0 
     96            END IF 
    8497         ENDIF 
    8598         ! 
     
    113126      CASE ( 2 )                             !==  fw adjustment based on fw budget at the end of the previous year  ==! 
    114127         ! 
    115          IF( kt == nit000 ) THEN                      ! initialisation 
    116             !                                         ! read the fw adjustment (a_fwb) 
    117             IF ( ln_rstart .AND. iom_varid( numror, 'a_fwb',   ldstop = .FALSE. ) > 0 ) THEN 
     128         IF( kt == nit000 ) THEN                                                                    ! initialisation 
     129            !                                                                                       ! set the fw adjustment (a_fwb) 
     130            IF ( ln_rstart .AND. iom_varid( numror, 'a_fwb',   ldstop = .FALSE. ) > 0 ) THEN        !    as read from restart file 
    118131               IF(lwp) WRITE(numout,*) 'sbc_fwb : reading FW-budget adjustment from restart file' 
    119132               CALL iom_get( numror, 'a_fwb',   a_fwb,   ldxios = lrxios ) 
    120             ELSE 
    121                CALL ctl_opn( inum, 'EMPave_old.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    122                READ ( inum, "(24X,I8,2ES24.16)" ) iyear, a_fwb 
    123                CLOSE( inum ) 
     133            ELSE                                                                                    !    as specified in namelist 
     134               a_fwb = rn_fwb0 
    124135            END IF 
    125136            ! 
    126137            IF(lwp)WRITE(numout,*) 
    127             IF(lwp)WRITE(numout,*)'sbc_fwb : year = ',iyear  , ' freshwater budget correction = ', a_fwb 
    128             IF(lwp)WRITE(numout,*)'          year = ',iyear-1, ' freshwater budget read       = ', a_fwb 
     138            IF(lwp)WRITE(numout,*)'sbc_fwb : initial freshwater-budget adjustment = ', a_fwb, 'kg/m2/s' 
    129139            ! 
    130140            IF( lwxios ) THEN                         ! Activate output of restart variables 
     
    157167         END IF 
    158168         ! 
    159          IF( kt == nitend .AND. lwm ) THEN            ! save a_fwb value in a file (only one required) 
    160             CALL ctl_opn( inum, 'EMPave.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 
    161             WRITE( inum, "(24X,I8,2ES24.16)" ) nyear, a_fwb 
    162             CLOSE( inum ) 
    163          ENDIF 
     169         IF( kt == nitend .AND. lwp ) WRITE(numout,*) 'sbc_fwb : final freshwater-budget adjustment = ', a_fwb, 'kg/m2/s' 
    164170         ! 
    165171      CASE ( 3 )                             !==  global fwf set to zero and spread out over erp area  ==! 
Note: See TracChangeset for help on using the changeset viewer.