- Timestamp:
- 2020-02-25T18:24:46+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/r12083_cpl-pressure/src/OCE/SBC/sbcapr.F90
r11715 r12461 16 16 USE fldread ! read input fields 17 17 USE in_out_manager ! I/O manager 18 USE lib_fortran ! distribu ed memory computing library18 USE lib_fortran ! distributed memory computing library 19 19 USE iom ! IOM library 20 20 USE lib_mpp ! MPP library … … 29 29 LOGICAL, PUBLIC :: ln_apr_obc = .false. !: inverse barometer added to OBC ssh data 30 30 LOGICAL, PUBLIC :: ln_ref_apr !: ref. pressure: global mean Patm (F) or a constant (F) 31 REAL(wp) 31 REAL(wp),PUBLIC :: rn_pref ! reference atmospheric pressure [N/m2] 32 32 33 33 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: ssh_ib ! Inverse barometer now sea surface height [m] … … 35 35 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: apr ! atmospheric pressure at kt [N/m2] 36 36 37 REAL(wp) :: tarea! whole domain mean masked ocean surface38 REAL(wp) :: r1_grau! = 1.e0 / (grav * rau0)37 REAL(wp), PUBLIC :: tarea ! whole domain mean masked ocean surface 38 REAL(wp), PUBLIC :: r1_grau ! = 1.e0 / (grav * rau0) 39 39 40 LOGICAL, PUBLIC :: cpl_mslp = .FALSE. ! Presure is passed via coupling 41 40 42 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_apr ! structure of input fields (file informations, fields read) 41 43 … … 78 80 IF(lwm) WRITE ( numond, namsbc_apr ) 79 81 ! 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' ) 82 IF( .NOT. cpl_mslp ) THEN 83 ALLOCATE( sf_apr(1), STAT=ierror ) !* allocate and fill sf_sst (forcing structure) with sn_sst 84 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' ) 85 ! 86 CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' ) 84 87 ALLOCATE( sf_apr(1)%fnow(jpi,jpj,1) ) 85 IF( sn_apr%ln_tint ) ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) ) 86 ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) ) 87 ALLOCATE( apr (jpi,jpj) ) 88 IF( sn_apr%ln_tint ) ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) ) 89 ENDIF 90 ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) ) 91 ALLOCATE( apr (jpi,jpj) ) 88 92 ! 89 93 IF( lwp )THEN !* control print 90 94 WRITE(numout,*) 91 WRITE(numout,*) ' Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing' 95 IF( cpl_mslp ) THEN 96 WRITE(numout,*) ' Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing' 97 ELSE 98 WRITE(numout,*) ' Namelist namsbc_apr : Atmospheric Pressure as extrenal forcing' 99 ENDIF 92 100 WRITE(numout,*) ' ref. pressure: global mean Patm (T) or a constant (F) ln_ref_apr = ', ln_ref_apr 93 101 ENDIF … … 132 140 !!---------------------------------------------------------------------- 133 141 134 ! ! ========================== ! 135 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! At each sbc time-step ! 136 ! ! ===========+++============ ! 137 ! 138 IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields 139 ! 140 CALL fld_read( kt, nn_fsbc, sf_apr ) !* input Patm provided at kt + nn_fsbc/2 141 ! 142 ! !* update the reference atmospheric pressure (if necessary) 143 IF( ln_ref_apr ) rn_pref = glob_sum( 'sbcapr', sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea 144 ! 145 ! !* Patm related forcing at kt 146 ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_grau ! equivalent ssh (inverse barometer) 147 apr (:,:) = sf_apr(1)%fnow(:,:,1) ! atmospheric pressure 148 ! 149 CALL iom_put( "ssh_ib", ssh_ib ) !* output the inverse barometer ssh 150 ENDIF 151 152 ! ! ---------------------------------------- ! 153 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! 154 ! ! ---------------------------------------- ! 155 ! !* Restart: read in restart file 156 IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN 157 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb read in the restart file' 158 CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb, ldxios = lrxios ) ! before inv. barometer ssh 159 ! 160 ELSE !* no restart: set from nit000 values 161 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb set to nit000 values' 162 ssh_ibb(:,:) = ssh_ib(:,:) 142 IF( .NOT. cpl_mslp ) THEN 143 ! ========================== ! 144 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! At each sbc time-step ! 145 ! ! ===========+++============ ! 146 IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields 147 ! 148 CALL fld_read( kt, nn_fsbc, sf_apr ) !* input Patm provided at kt + nn_fsbc/2 149 ! 150 ! !* update the reference atmospheric pressure (if necessary) 151 IF( ln_ref_apr ) rn_pref = glob_sum( 'sbcapr', sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea 152 ! 153 ! !* Patm related forcing at kt 154 ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_grau ! equivalent ssh (inverse barometer) 155 apr (:,:) = sf_apr(1)%fnow(:,:,1) ! atmospheric pressure 156 ! 157 CALL iom_put( "ssh_ib", ssh_ib ) !* output the inverse barometer ssh 163 158 ENDIF 164 ENDIF 165 ! ! ---------------------------------------- ! 166 IF( lrst_oce ) THEN ! Write in the ocean restart file ! 167 ! ! ---------------------------------------- ! 168 IF(lwp) WRITE(numout,*) 169 IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp 170 IF(lwp) WRITE(numout,*) '~~~~' 171 IF( lwxios ) CALL iom_swap( cwxios_context ) 172 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib, ldxios = lwxios ) 159 160 ! ! ---------------------------------------- ! 161 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! 162 ! ! ---------------------------------------- ! 163 ! !* Restart: read in restart file 164 IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN 165 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb read in the restart file' 166 CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb ) ! before inv. barometer ssh 167 ! 168 ELSE !* no restart: set from nit000 values 169 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb set to nit000 values' 170 ssh_ibb(:,:) = ssh_ib(:,:) 171 ENDIF 172 ENDIF 173 ! ! ---------------------------------------- ! 174 IF( lrst_oce ) THEN ! Write in the ocean restart file ! 175 ! ! ---------------------------------------- ! 176 IF(lwp) WRITE(numout,*) 177 IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp 178 IF(lwp) WRITE(numout,*) '~~~~' 179 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib ) 180 ENDIF 173 181 IF( lwxios ) CALL iom_swap( cxios_context ) 174 182 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
