- Timestamp:
- 2012-11-27T17:51:05+01:00 (11 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r3643 r3690 401 401 CALL histdef( nid_T, "sowindsp", "wind speed at 10m" , "m/s" , & ! wndm 402 402 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 403 #if ! defined key_coupled 404 CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp 405 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 406 CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping" , "Kg/m2/s", & ! erp 407 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 408 CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping" , "Kg/m2/s", & ! erp * sn 409 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 410 #endif 411 412 413 414 #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 ) 415 CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping" , "W/m2" , & ! qrp 416 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 417 CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping" , "Kg/m2/s", & ! erp 418 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 419 CALL histdef( nid_T, "sosafldp", "Surface salt flux: Damping" , "Kg/m2/s", & ! erp * sn 420 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 421 #endif 403 IF( ln_ssr ) THEN 404 IF( nn_sstr /= 0 ) THEN 405 CALL histdef( nid_T, "sohefldp", "Surface Heat Flux: Damping", "W/m2" , & ! qrp 406 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 407 ENDIF 408 IF( nn_sssr /= 0 ) THEN 409 CALL histdef( nid_T, "sowafldp", "Surface Water Flux: Damping" , "Kg/m2/s", & ! erp 410 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 411 CALL histdef( nid_T, "sosafldp", "Surface salt flux: damping" , "Kg/m2/s", & ! erp * sn 412 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 413 ENDIF 414 ENDIF 422 415 clmx ="l_max(only(x))" ! max index on a period 423 416 CALL histdef( nid_T, "sobowlin", "Bowl Index" , "W-point", & ! bowl INDEX 424 417 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clmx, zsto, zout ) 425 418 #if defined key_diahth 426 CALL histdef( nid_T, "sothedep", "Thermocline Depth" , "m" , & ! hth427 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 428 CALL histdef( nid_T, "so20chgt", "Depth of 20C isotherm" , "m" , & ! hd20429 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 430 CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm" , "m" , & ! hd28431 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 432 CALL histdef( nid_T, "sohtc300", "Heat content 300 m" , "W" , & ! htc3419 CALL histdef( nid_T, "sothedep", "Thermocline Depth" , "m" , & ! hth 420 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 421 CALL histdef( nid_T, "so20chgt", "Depth of 20C isotherm" , "m" , & ! hd20 422 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 423 CALL histdef( nid_T, "so28chgt", "Depth of 28C isotherm" , "m" , & ! hd28 424 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 425 CALL histdef( nid_T, "sohtc300", "Heat content 300 m" , "W" , & ! htc3 433 426 & jpi, jpj, nh_T, 1 , 1, 1 , -99 , 32, clop, zsto, zout ) 434 427 #endif … … 555 548 CALL histwrite( nid_T, "soicecov", it, fr_i , ndim_hT, ndex_hT ) ! ice fraction 556 549 CALL histwrite( nid_T, "sowindsp", it, wndm , ndim_hT, ndex_hT ) ! wind speed 557 #if ! defined key_coupled 558 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 559 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping 560 IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 561 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 562 #endif 563 #if ( defined key_coupled && ! defined key_lim3 && ! defined key_lim2 ) 564 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 565 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping 566 IF( ln_ssr ) zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 567 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 568 #endif 550 IF( ln_ssr ) THEN 551 IF( nn_sstr /= 0 ) THEN 552 CALL histwrite( nid_T, "sohefldp", it, qrp , ndim_hT, ndex_hT ) ! heat flux damping 553 ENDIF 554 IF( nn_sssr /= 0 ) THEN 555 CALL histwrite( nid_T, "sowafldp", it, erp , ndim_hT, ndex_hT ) ! freshwater flux damping 556 zw2d(:,:) = erp(:,:) * tsn(:,:,1,jp_sal) * tmask(:,:,1) 557 CALL histwrite( nid_T, "sosafldp", it, zw2d , ndim_hT, ndex_hT ) ! salt flux damping 558 ENDIF 559 ENDIF 569 560 zw2d(:,:) = FLOAT( nmln(:,:) ) * tmask(:,:,1) 570 561 CALL histwrite( nid_T, "sobowlin", it, zw2d , ndim_hT, ndex_hT ) ! ??? -
trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri_dimg.h90
r3294 r3690 164 164 fsel(:,:,6 ) = fsel(:,:,6 ) + sshn(:,:) 165 165 fsel(:,:,7 ) = fsel(:,:,7 ) + qsr(:,:) 166 fsel(:,:,8 ) = fsel(:,:,8 ) + qrp (:,:) 167 fsel(:,:,9 ) = fsel(:,:,9 ) + erp (:,:) 166 IF( ln_ssr ) THEN 167 IF( nn_sstr /= 0 ) fsel(:,:,8 ) = fsel(:,:,8 ) + qrp (:,:) 168 IF( nn_sssr /= 0 ) fsel(:,:,9 ) = fsel(:,:,9 ) + erp (:,:) 169 ENDIF 168 170 fsel(:,:,10) = fsel(:,:,10) + hmld(:,:) 169 171 fsel(:,:,11) = fsel(:,:,11) + hmlp(:,:) … … 232 234 fsel(:,:,6 ) = sshn(:,:) 233 235 fsel(:,:,7 ) = qsr (:,:) * tmask(:,:,1) 234 fsel(:,:,8 ) = qrp (:,:) * tmask(:,:,1) 235 fsel(:,:,9 ) = erp (:,:) * tmask(:,:,1) 236 IF( ln_ssr ) THEN 237 IF( nn_sstr /= 0 ) fsel(:,:,8 ) = qrp (:,:) * tmask(:,:,1) 238 IF( nn_sssr /= 0 ) fsel(:,:,9 ) = erp (:,:) * tmask(:,:,1) 239 ENDIF 236 240 fsel(:,:,10) = hmld(:,:) * tmask(:,:,1) 237 241 fsel(:,:,11) = hmlp(:,:) * tmask(:,:,1) -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r3421 r3690 199 199 IF( nsbc == 6 ) WRITE(numout,*) ' MFS Bulk formulation' 200 200 ENDIF 201 202 IF( nn_ice == 4 ) CALL cice_sbc_init (nsbc) 201 ! 202 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialisation 203 ! 204 IF( nn_ice == 4 ) CALL cice_sbc_init( nsbc ) ! CICE initialisation 203 205 ! 204 206 END SUBROUTINE sbc_init … … 367 369 END SUBROUTINE sbc 368 370 371 369 372 SUBROUTINE sbc_final 370 373 !!--------------------------------------------------------------------- 371 374 !! *** ROUTINE sbc_final *** 372 !!--------------------------------------------------------------------- 373 374 !----------------------------------------------------------------- 375 ! Finalize CICE (if used) 376 !----------------------------------------------------------------- 377 375 !! 376 !! ** Purpose : Finalize CICE (if used) 377 !!--------------------------------------------------------------------- 378 ! 378 379 IF( nn_ice == 4 ) CALL cice_sbc_final 379 380 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90
r3558 r3690 27 27 PRIVATE 28 28 29 PUBLIC sbc_ssr ! routine called in sbcmod 29 PUBLIC sbc_ssr ! routine called in sbcmod 30 PUBLIC sbc_ssr_init ! routine called in sbcmod 30 31 31 32 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: erp !: evaporation damping [kg/m2/s] … … 83 84 IF( nn_timing == 1 ) CALL timing_start('sbc_ssr') 84 85 ! 85 ! ! -------------------- !86 IF( kt == nit000 ) THEN ! First call kt=nit000 !87 ! ! -------------------- !88 ! !* set file information89 cn_dir = './' ! directory in which the model is executed90 ! ... default values (NB: frequency positive => hours, negative => months)91 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation !92 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs !93 sn_sst = FLD_N( 'sst' , 24 , 'sst' , .false. , .false. , 'yearly' , '' , '' )94 sn_sss = FLD_N( 'sss' , -1 , 'sss' , .true. , .false. , 'yearly' , '' , '' )95 96 REWIND ( numnam ) !* read in namlist namflx97 READ( numnam, namsbc_ssr )98 99 IF(lwp) THEN !* control print100 WRITE(numout,*)101 WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term '102 WRITE(numout,*) '~~~~~~~ '103 WRITE(numout,*) ' Namelist namsbc_ssr :'104 WRITE(numout,*) ' SST restoring term (Yes=1) nn_sstr = ', nn_sstr105 WRITE(numout,*) ' SSS damping term (Yes=1, salt flux) nn_sssr = ', nn_sssr106 WRITE(numout,*) ' (Yes=2, volume flux) '107 WRITE(numout,*) ' dQ/dT (restoring magnitude on SST) rn_dqdt = ', rn_dqdt, ' W/m2/K'108 WRITE(numout,*) ' dE/dS (restoring magnitude on SST) rn_deds = ', rn_deds, ' mm/day'109 WRITE(numout,*) ' flag to bound erp term ln_sssr_bnd = ', ln_sssr_bnd110 WRITE(numout,*) ' ABS(Max./Min.) erp threshold rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day'111 ENDIF112 113 ! Allocate erp and qrp array114 ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror )115 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' )116 117 IF( nn_sstr == 1 ) THEN !* set sf_sst structure & allocate arrays118 !119 ALLOCATE( sf_sst(1), STAT=ierror )120 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst structure' )121 ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1), STAT=ierror )122 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst now array' )123 !124 ! fill sf_sst with sn_sst and control print125 CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' )126 IF( sf_sst(1)%ln_tint ) ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2), STAT=ierror )127 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst data array' )128 !129 ENDIF130 !131 IF( nn_sssr >= 1 ) THEN ! set sf_sss structure & allocate arrays132 !133 ALLOCATE( sf_sss(1), STAT=ierror )134 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss structure' )135 ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1), STAT=ierror )136 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss now array' )137 !138 ! fill sf_sss with sn_sss and control print139 CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' )140 IF( sf_sss(1)%ln_tint ) ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2), STAT=ierror )141 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss data array' )142 !143 ENDIF144 !145 ! Initialize qrp and erp if no restoring146 IF( nn_sstr /= 1 ) qrp(:,:) = 0.e0147 IF( nn_sssr /= 1 .OR. nn_sssr /= 2 ) erp(:,:) = 0.e0148 ENDIF149 150 86 IF( nn_sstr + nn_sssr /= 0 ) THEN 151 87 ! … … 208 144 ! 209 145 END SUBROUTINE sbc_ssr 146 147 148 SUBROUTINE sbc_ssr_init 149 !!--------------------------------------------------------------------- 150 !! *** ROUTINE sbc_ssr_init *** 151 !! 152 !! ** Purpose : initialisation of surface damping term 153 !! 154 !! ** Method : - Read namelist namsbc_ssr 155 !! - Read observed SST and/or SSS if required 156 !!--------------------------------------------------------------------- 157 INTEGER :: ji, jj ! dummy loop indices 158 REAL(wp) :: zerp ! local scalar for evaporation damping 159 REAL(wp) :: zqrp ! local scalar for heat flux damping 160 REAL(wp) :: zsrp ! local scalar for unit conversion of rn_deds factor 161 REAL(wp) :: zerp_bnd ! local scalar for unit conversion of rn_epr_max factor 162 INTEGER :: ierror ! return error code 163 !! 164 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 165 TYPE(FLD_N) :: sn_sst, sn_sss ! informations about the fields to be read 166 NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd 167 !!---------------------------------------------------------------------- 168 ! 169 ! !* set file information 170 cn_dir = './' ! directory in which the model is executed 171 ! ... default values (NB: frequency positive => hours, negative => months) 172 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 173 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 174 sn_sst = FLD_N( 'sst' , 24 , 'sst' , .false. , .false. , 'yearly' , '' , '' ) 175 sn_sss = FLD_N( 'sss' , -1 , 'sss' , .true. , .false. , 'yearly' , '' , '' ) 176 177 REWIND( numnam ) !* read in namlist namflx 178 READ ( numnam, namsbc_ssr ) 179 180 IF(lwp) THEN !* control print 181 WRITE(numout,*) 182 WRITE(numout,*) 'sbc_ssr : SST and/or SSS damping term ' 183 WRITE(numout,*) '~~~~~~~ ' 184 WRITE(numout,*) ' Namelist namsbc_ssr :' 185 WRITE(numout,*) ' SST restoring term (Yes=1) nn_sstr = ', nn_sstr 186 WRITE(numout,*) ' SSS damping term (Yes=1, salt flux) nn_sssr = ', nn_sssr 187 WRITE(numout,*) ' (Yes=2, volume flux) ' 188 WRITE(numout,*) ' dQ/dT (restoring magnitude on SST) rn_dqdt = ', rn_dqdt, ' W/m2/K' 189 WRITE(numout,*) ' dE/dS (restoring magnitude on SST) rn_deds = ', rn_deds, ' mm/day' 190 WRITE(numout,*) ' flag to bound erp term ln_sssr_bnd = ', ln_sssr_bnd 191 WRITE(numout,*) ' ABS(Max./Min.) erp threshold rn_sssr_bnd = ', rn_sssr_bnd, ' mm/day' 192 ENDIF 193 ! 194 ! !* Allocate erp and qrp array 195 ALLOCATE( qrp(jpi,jpj), erp(jpi,jpj), STAT=ierror ) 196 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate erp and qrp array' ) 197 ! 198 IF( nn_sstr == 1 ) THEN !* set sf_sst structure & allocate arrays 199 ! 200 ALLOCATE( sf_sst(1), STAT=ierror ) 201 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst structure' ) 202 ALLOCATE( sf_sst(1)%fnow(jpi,jpj,1), STAT=ierror ) 203 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst now array' ) 204 ! 205 ! fill sf_sst with sn_sst and control print 206 CALL fld_fill( sf_sst, (/ sn_sst /), cn_dir, 'sbc_ssr', 'SST restoring term toward SST data', 'namsbc_ssr' ) 207 IF( sf_sst(1)%ln_tint ) ALLOCATE( sf_sst(1)%fdta(jpi,jpj,1,2), STAT=ierror ) 208 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sst data array' ) 209 ! 210 ENDIF 211 ! 212 IF( nn_sssr >= 1 ) THEN !* set sf_sss structure & allocate arrays 213 ! 214 ALLOCATE( sf_sss(1), STAT=ierror ) 215 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss structure' ) 216 ALLOCATE( sf_sss(1)%fnow(jpi,jpj,1), STAT=ierror ) 217 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss now array' ) 218 ! 219 ! fill sf_sss with sn_sss and control print 220 CALL fld_fill( sf_sss, (/ sn_sss /), cn_dir, 'sbc_ssr', 'SSS restoring term toward SSS data', 'namsbc_ssr' ) 221 IF( sf_sss(1)%ln_tint ) ALLOCATE( sf_sss(1)%fdta(jpi,jpj,1,2), STAT=ierror ) 222 IF( ierror > 0 ) CALL ctl_stop( 'STOP', 'sbc_ssr: unable to allocate sf_sss data array' ) 223 ! 224 ENDIF 225 ! 226 ! !* Initialize qrp and erp if no restoring 227 IF( nn_sstr /= 1 ) qrp(:,:) = 0._wp 228 IF( nn_sssr /= 1 .OR. nn_sssr /= 2 ) erp(:,:) = 0._wp 229 ! 230 END SUBROUTINE sbc_ssr_init 210 231 211 232 !!======================================================================
Note: See TracChangeset
for help on using the changeset viewer.