Changeset 11286 for branches/UKMO/AMM15_v3_6_STABLE_package_collate_xeps/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
- Timestamp:
- 2019-07-18T11:54:22+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/AMM15_v3_6_STABLE_package_collate_xeps/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90
r8058 r11286 26 26 27 27 ! !!* namsbc_apr namelist (Atmospheric PRessure) * 28 LOGICAL, PUBLIC :: cpl_mslp = .FALSE. ! Is the pressure read from 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) … … 85 86 IF(lwm) WRITE ( numond, namsbc_apr ) 86 87 ! 87 ALLOCATE( sf_apr(1), STAT=ierror ) !* allocate and fill sf_sst (forcing structure) with sn_sst 88 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' ) 89 ! 90 CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' ) 91 ALLOCATE( sf_apr(1)%fnow(jpi,jpj,1) ) 92 IF( sn_apr%ln_tint ) ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) ) 88 IF( .NOT. cpl_mslp ) THEN 89 ALLOCATE( sf_apr(1), STAT=ierror ) !* allocate and fill sf_sst (forcing structure) with sn_sst 90 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_apr: unable to allocate sf_apr structure' ) 91 ! 92 CALL fld_fill( sf_apr, (/ sn_apr /), cn_dir, 'sbc_apr', 'Atmospheric pressure ', 'namsbc_apr' ) 93 ALLOCATE( sf_apr(1)%fnow(jpi,jpj,1) ) 94 IF( sn_apr%ln_tint ) ALLOCATE( sf_apr(1)%fdta(jpi,jpj,1,2) ) 95 ENDIF 93 96 ALLOCATE( ssh_ib(jpi,jpj) , ssh_ibb(jpi,jpj) ) 94 97 ALLOCATE( apr (jpi,jpj) ) … … 96 99 IF(lwp) THEN !* control print 97 100 WRITE(numout,*) 98 WRITE(numout,*) ' Namelist namsbc_apr : Atmospheric PRessure as extrenal forcing' 101 IF( cpl_mslp ) THEN 102 WRITE(numout,*) ' Namelist namsbc_apr : Atmospheric Pressure as extrenal coupling' 103 ELSE 104 WRITE(numout,*) ' Namelist namsbc_apr : Atmospheric Pressure as extrenal forcing' 105 ENDIF 99 106 WRITE(numout,*) ' ref. pressure: global mean Patm (T) or a constant (F) ln_ref_apr = ', ln_ref_apr 100 107 ENDIF … … 119 126 ENDIF 120 127 121 ! ! ========================== ! 122 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! At each sbc time-step ! 123 ! ! ===========+++============ ! 124 ! 125 IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields 126 ! 127 CALL fld_read( kt, nn_fsbc, sf_apr ) !* input Patm provided at kt + nn_fsbc/2 128 ! 129 ! !* update the reference atmospheric pressure (if necessary) 130 IF( ln_ref_apr ) rn_pref = glob_sum( sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea 131 ! 132 ! !* Patm related forcing at kt 133 ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_grau ! equivalent ssh (inverse barometer) 134 apr (:,:) = sf_apr(1)%fnow(:,:,1) ! atmospheric pressure 135 ! 136 CALL iom_put( "ssh_ib", ssh_ib ) !* output the inverse barometer ssh 137 ENDIF 138 139 ! ! ---------------------------------------- ! 140 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! 141 ! ! ---------------------------------------- ! 142 ! !* Restart: read in restart file 143 IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN 144 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb read in the restart file' 145 CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb ) ! before inv. barometer ssh 128 IF( .NOT. cpl_mslp ) THEN ! ========================== ! 129 IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! At each sbc time-step ! 130 ! ! ===========+++============ ! 146 131 ! 147 ELSE !* no restart: set from nit000 values 148 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb set to nit000 values' 149 ssh_ibb(:,:) = ssh_ib(:,:) 132 IF( kt /= nit000 ) ssh_ibb(:,:) = ssh_ib(:,:) !* Swap of ssh_ib fields 133 ! 134 CALL fld_read( kt, nn_fsbc, sf_apr ) !* input Patm provided at kt + nn_fsbc/2 135 ! 136 ! !* update the reference atmospheric pressure (if necessary) 137 IF( ln_ref_apr ) rn_pref = glob_sum( sf_apr(1)%fnow(:,:,1) * e1e2t(:,:) ) / tarea 138 ! 139 ! !* Patm related forcing at kt 140 ssh_ib(:,:) = - ( sf_apr(1)%fnow(:,:,1) - rn_pref ) * r1_grau ! equivalent ssh (inverse barometer) 141 apr (:,:) = sf_apr(1)%fnow(:,:,1) ! atmospheric pressure 142 ! 143 CALL iom_put( "ssh_ib", ssh_ib ) !* output the inverse barometer ssh 150 144 ENDIF 151 ENDIF 152 ! ! ---------------------------------------- ! 153 IF( lrst_oce ) THEN ! Write in the ocean restart file ! 154 ! ! ---------------------------------------- ! 155 IF(lwp) WRITE(numout,*) 156 IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp 157 IF(lwp) WRITE(numout,*) '~~~~' 158 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib ) 145 146 ! ! ---------------------------------------- ! 147 IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 ! 148 ! ! ---------------------------------------- ! 149 ! !* Restart: read in restart file 150 IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN 151 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb read in the restart file' 152 CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb ) ! before inv. barometer ssh 153 ! 154 ELSE !* no restart: set from nit000 values 155 IF(lwp) WRITE(numout,*) 'sbc_apr: ssh_ibb set to nit000 values' 156 ssh_ibb(:,:) = ssh_ib(:,:) 157 ENDIF 158 ENDIF 159 ! ! ---------------------------------------- ! 160 IF( lrst_oce ) THEN ! Write in the ocean restart file ! 161 ! ! ---------------------------------------- ! 162 IF(lwp) WRITE(numout,*) 163 IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp 164 IF(lwp) WRITE(numout,*) '~~~~' 165 CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib ) 166 ENDIF 159 167 ENDIF 160 168 !
Note: See TracChangeset
for help on using the changeset viewer.
