Changeset 14200 for NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcfwb.F90
- Timestamp:
- 2020-12-17T15:36:44+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r14116_HPC-04_mcastril_Mixed_Precision_implementation_final/src/OCE/SBC/sbcfwb.F90
r13582 r14200 24 24 ! 25 25 USE in_out_manager ! I/O manager 26 USE iom ! IOM 26 27 USE lib_mpp ! distribued memory computing library 27 28 USE timing ! Timing … … 34 35 PUBLIC sbc_fwb ! routine called by step 35 36 36 REAL(wp) :: a_fwb_b ! annual domain averaged freshwater budget37 REAL(wp) :: a_fwb ! for 2 year before (_b) and before year.38 REAL(wp) :: fwfold ! fwfold to be suppressed37 REAL(wp) :: rn_fwb0 ! initial freshwater adjustment flux [kg/m2/s] (nn_fwb = 2 only) 38 REAL(wp) :: a_fwb ! annual domain averaged freshwater budget from the 39 ! previous year 39 40 REAL(wp) :: area ! global mean ocean surface (interior domain) 40 41 … … 65 66 INTEGER, INTENT( in ) :: Kmm ! ocean time level index 66 67 ! 67 INTEGER :: i num, ikty, iyear! local integers68 INTEGER :: ios, inum, ikty ! local integers 68 69 REAL(wp) :: z_fwf, z_fwf_nsrf, zsum_fwf, zsum_erp ! local scalars 69 70 REAL(wp) :: zsurf_neg, zsurf_pos, zsurf_tospread, zcoef ! - - … … 72 73 REAL(wp) ,DIMENSION(1) :: z_fwfprv 73 74 COMPLEX(dp),DIMENSION(1) :: y_fwfnow 75 ! 76 NAMELIST/namsbc_fwb/rn_fwb0 74 77 !!---------------------------------------------------------------------- 75 78 ! 76 79 IF( kt == nit000 ) THEN 80 READ( numnam_ref, namsbc_fwb, IOSTAT = ios, ERR = 901 ) 81 901 IF( ios /= 0 ) CALL ctl_nam( ios, 'namsbc_fwb in reference namelist' ) 82 READ( numnam_cfg, namsbc_fwb, IOSTAT = ios, ERR = 902 ) 83 902 IF( ios > 0 ) CALL ctl_nam( ios, 'namsbc_fwb in configuration namelist' ) 84 IF(lwm) WRITE( numond, namsbc_fwb ) 77 85 IF(lwp) THEN 78 86 WRITE(numout,*) … … 80 88 WRITE(numout,*) '~~~~~~~' 81 89 IF( kn_fwb == 1 ) WRITE(numout,*) ' instantaneously set to zero' 82 IF( kn_fwb == 2 ) WRITE(numout,*) ' adjusted from previous year budget'83 90 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 84 97 ENDIF 85 98 ! … … 112 125 ENDIF 113 126 ! 114 CASE ( 2 ) !== fwf budget adjusted from the previous year ==! 115 ! 116 IF( kt == nit000 ) THEN ! initialisation 117 ! ! Read the corrective factor on precipitations (fwfold) 118 CALL ctl_opn( inum, 'EMPave_old.dat', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 119 READ ( inum, "(24X,I8,2ES24.16)" ) iyear, a_fwb_b, a_fwb 120 CLOSE( inum ) 121 fwfold = a_fwb ! current year freshwater budget correction 122 ! ! estimate from the previous year budget 127 CASE ( 2 ) !== fw adjustment based on fw budget at the end of the previous year ==! 128 ! 129 IF( kt == nit000 ) THEN ! initialisation 130 ! ! set the fw adjustment (a_fwb) 131 IF ( ln_rstart .AND. iom_varid( numror, 'a_fwb', ldstop = .FALSE. ) > 0 ) THEN ! as read from restart file 132 IF(lwp) WRITE(numout,*) 'sbc_fwb : reading FW-budget adjustment from restart file' 133 CALL iom_get( numror, 'a_fwb', a_fwb ) 134 ELSE ! as specified in namelist 135 a_fwb = rn_fwb0 136 END IF 137 ! 123 138 IF(lwp)WRITE(numout,*) 124 IF(lwp)WRITE(numout,*)'sbc_fwb : year = ',iyear , ' freshwater budget correction = ', fwfold 125 IF(lwp)WRITE(numout,*)' year = ',iyear-1, ' freshwater budget read = ', a_fwb 126 IF(lwp)WRITE(numout,*)' year = ',iyear-2, ' freshwater budget read = ', a_fwb_b 139 IF(lwp)WRITE(numout,*)'sbc_fwb : initial freshwater-budget adjustment = ', a_fwb, 'kg/m2/s' 140 ! 127 141 ENDIF 128 ! ! Update fwfoldif new year start142 ! ! Update a_fwb if new year start 129 143 ikty = 365 * 86400 / rn_Dt !!bug use of 365 days leap year or 360d year !!!!!!! 130 144 IF( MOD( kt, ikty ) == 0 ) THEN 131 a_fwb_b = a_fwb! mean sea level taking into account the ice+snow145 ! mean sea level taking into account the ice+snow 132 146 ! sum over the global domain 133 147 a_fwb = glob_sum( 'sbcfwb', e1e2t(:,:) * ( ssh(:,:,Kmm) + snwice_mass(:,:) * r1_rho0 ) ) 134 148 a_fwb = a_fwb * 1.e+3 / ( area * rday * 365. ) ! convert in Kg/m3/s = mm/s 135 149 !!gm ! !!bug 365d year 136 fwfold = a_fwb ! current year freshwater budget correction137 ! ! estimate from the previous year budget138 150 ENDIF 139 151 ! 140 152 IF( MOD( kt-1, kn_fsbc ) == 0 ) THEN ! correct the freshwater fluxes 141 zcoef = fwfold* rcp142 emp(:,:) = emp(:,:) + fwfold* tmask(:,:,1)153 zcoef = a_fwb * rcp 154 emp(:,:) = emp(:,:) + a_fwb * tmask(:,:,1) 143 155 qns(:,:) = qns(:,:) - zcoef * sst_m(:,:) * tmask(:,:,1) ! account for change to the heat budget due to fw correction 144 156 ENDIF 145 ! 146 IF( kt == nitend .AND. lwm ) THEN ! save fwfold value in a file (only one required) 147 CALL ctl_opn( inum, 'EMPave.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 148 WRITE( inum, "(24X,I8,2ES24.16)" ) nyear, a_fwb_b, a_fwb 149 CLOSE( inum ) 150 ENDIF 157 ! Output restart information 158 IF( lrst_oce ) THEN 159 IF(lwp) WRITE(numout,*) 160 IF(lwp) WRITE(numout,*) 'sbc_fwb : writing FW-budget adjustment to ocean restart file at it = ', kt 161 IF(lwp) WRITE(numout,*) '~~~~' 162 CALL iom_rstput( kt, nitrst, numrow, 'a_fwb', a_fwb ) 163 END IF 164 ! 165 IF( kt == nitend .AND. lwp ) WRITE(numout,*) 'sbc_fwb : final freshwater-budget adjustment = ', a_fwb, 'kg/m2/s' 151 166 ! 152 167 CASE ( 3 ) !== global fwf set to zero and spread out over erp area ==!
Note: See TracChangeset
for help on using the changeset viewer.