- Timestamp:
- 2019-03-26T11:46:36+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/r8395_cpl-pressure/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
r10797 r10803 26 26 27 27 ! !!* namsbc_apr namelist (Atmospheric PRessure) * 28 LOGICAL, PUBLIC :: cpl_mslp = .FALSE. ! Presure is passed via coupling 28 29 LOGICAL, PUBLIC :: ln_apr_obc !: inverse barometer added to OBC ssh data 29 30 LOGICAL, PUBLIC :: ln_ref_apr !: ref. pressure: global mean Patm (F) or a constant (F) 30 REAL(wp) 31 REAL(wp),PUBLIC :: rn_pref ! reference atmospheric pressure [N/m2] 31 32 32 33 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: ssh_ib ! Inverse barometer now sea surface height [m] … … 34 35 REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) :: apr ! atmospheric pressure at kt [N/m2] 35 36 36 REAL(wp) :: tarea! whole domain mean masked ocean surface37 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) 38 39 39 40 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_apr ! structure of input fields (file informations, fields read) … … 82 83 IF(lwm) WRITE ( numond, namsbc_apr ) 83 84 ! 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) ) 85 IF( .NOT. cpl_mslp ) THEN 86 ALLOCATE( sf_apr(1), STAT=ierror ) !* allocate and fill sf_sst (forcing structure) with sn_sst 87 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' ) 88 ! 89 CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' ) 90 ALLOCATE( sf_apr(1)%fnow(jpi,jpj,1) ) 91 IF( sn_apr%ln_tint ) ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) ) 92 ENDIF 93 ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) ) 94 ALLOCATE( apr (jpi,jpj) ) 92 95 ! 93 96 IF(lwp) THEN !* control print 94 97 WRITE(numout,*) 95 WRITE(numout,*) ' Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing' 98 IF( cpl_mslp ) THEN 99 WRITE(numout,*) ' Namelist namsbc_apr : Atmospheric Pressure as extrenal coupling' 100 ELSE 101 WRITE(numout,*) ' Namelist namsbc_apr : Atmospheric Pressure as extrenal forcing' 102 ENDIF 96 103 WRITE(numout,*) ' ref. pressure: global mean Patm (T) or a constant (F) ln_ref_apr = ', ln_ref_apr 97 104 ENDIF … … 115 122 ENDIF 116 123 117 ! ! ========================== ! 118 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! At each sbc time-step ! 119 ! ! ===========+++============ ! 120 ! 121 IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields 122 ! 123 CALL fld_read( kt, nn_fsbc, sf_apr ) !* input Patm provided at kt + nn_fsbc/2 124 ! 125 ! !* update the reference atmospheric pressure (if necessary) 126 IF( ln_ref_apr ) rn_pref = glob_sum( sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea 127 ! 128 ! !* Patm related forcing at kt 129 ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_grau ! equivalent ssh (inverse barometer) 130 apr (:,:) = sf_apr(1)%fnow(:,:,1) ! atmospheric pressure 131 ! 132 CALL iom_put( "ssh_ib", ssh_ib ) !* output the inverse barometer ssh 133 ENDIF 134 135 ! ! ---------------------------------------- ! 136 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! 137 ! ! ---------------------------------------- ! 138 ! !* Restart: read in restart file 139 IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN 140 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb read in the restart file' 141 CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb ) ! before inv. barometer ssh 124 IF( .NOT. cpl_mslp ) THEN 125 ! ! ========================== ! 126 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! At each sbc time-step ! 127 ! ! ===========+++============ ! 142 128 ! 143 ELSE !* no restart: set from nit000 values 144 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb set to nit000 values' 145 ssh_ibb(:,:) = ssh_ib(:,:) 129 IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields 130 ! 131 CALL fld_read( kt, nn_fsbc, sf_apr ) !* input Patm provided at kt + nn_fsbc/2 132 ! 133 ! !* update the reference atmospheric pressure (if necessary) 134 IF( ln_ref_apr ) rn_pref = glob_sum( sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea 135 ! 136 ! !* Patm related forcing at kt 137 ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_grau ! equivalent ssh (inverse barometer) 138 apr (:,:) = sf_apr(1)%fnow(:,:,1) ! atmospheric pressure 139 ! 140 CALL iom_put( "ssh_ib", ssh_ib ) !* output the inverse barometer ssh 146 141 ENDIF 147 ENDIF 148 ! ! ---------------------------------------- ! 149 IF( lrst_oce ) THEN ! Write in the ocean restart file ! 150 ! ! ---------------------------------------- ! 151 IF(lwp) WRITE(numout,*) 152 IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp 153 IF(lwp) WRITE(numout,*) '~~~~' 154 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib ) 142 143 ! ! ---------------------------------------- ! 144 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! 145 ! ! ---------------------------------------- ! 146 ! !* Restart: read in restart file 147 IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN 148 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb read in the restart file' 149 CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb ) ! before inv. barometer ssh 150 ! 151 ELSE !* no restart: set from nit000 values 152 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb set to nit000 values' 153 ssh_ibb(:,:) = ssh_ib(:,:) 154 ENDIF 155 ENDIF 156 ! ! ---------------------------------------- ! 157 IF( lrst_oce ) THEN ! Write in the ocean restart file ! 158 ! ! ---------------------------------------- ! 159 IF(lwp) WRITE(numout,*) 160 IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp 161 IF(lwp) WRITE(numout,*) '~~~~' 162 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib ) 163 ENDIF 155 164 ENDIF 156 165 !
Note: See TracChangeset
for help on using the changeset viewer.
