source: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/config/ppsrc/phys/hydrol.f90 @ 224

Last change on this file since 224 was 224, checked in by ymipsl, 10 years ago
File size: 17.0 KB
Line 
1subroutine hydrol(ngrid,nq,ptimestep,rnat,tsurf,          &
2     qsurf,dqsurf,dqs_hyd,pcapcal,                &
3     albedo0,albedo,mu0,pdtsurf,pdtsurf_hyd,hice, &
4     pctsrf_sic,sea_ice)
5
6  use ioipsl_getincom 
7  use watercommon_h, only: T_h2O_ice_liq, RLFTT, rhowater, mx_eau_sol
8  USE surfdat_h
9  use comdiurn_h
10  USE comgeomfi_h
11  USE tracer_h
12  use slab_ice_h
13
14  implicit none
15
16!==================================================================
17!     
18!     Purpose
19!     -------
20!     Calculate the surface hydrology and albedo changes.
21!     
22!     Authors
23!     -------
24!     Adapted from LMDTERRE by B. Charnay (2010). Further
25!     modifications by R. Wordsworth (2010).
26!     
27!     Called by
28!     ---------
29!     physiq.F
30!     
31!     Calls
32!     -----
33!     none
34!
35!     Notes
36!     -----
37!     rnat is terrain type: 0-ocean; 1-continent
38!     
39!==================================================================
40
41!-----------------------------------------------------------------------
42!   INCLUDE 'dimensions.h'
43!
44!   dimensions.h contient les dimensions du modele
45!   ndm est tel que iim=2**ndm
46!-----------------------------------------------------------------------
47
48      INTEGER iim,jjm,llm,ndm
49
50      PARAMETER (iim= 128,jjm=96,llm=64,ndm=1)
51
52!-----------------------------------------------------------------------
53!-----------------------------------------------------------------------
54!   INCLUDE 'dimphys.h'
55
56! ngridmx : number of horizontal grid points
57! note: the -1/jjm term will be 0; unless jj=1
58      integer, parameter :: ngridmx = (2+(jjm-1)*iim - 1/jjm)   
59! nlayermx : number of atmospheric layers
60      integer, parameter :: nlayermx = llm 
61! nsoilmx : number of subterranean layers ! nsoilmx is now in comsoil_h
62      !integer, parameter :: nsoilmx = 4 ! for a test
63      !integer, parameter :: nsoilmx = 18 ! for z1=0.0002 m, depth = 18 m => mars case
64      !integer, parameter :: nsoilmx = 13 ! for z1=0.03 m, depth = 104.8 m => earth case
65!-----------------------------------------------------------------------
66
67!-----------------------------------------------------------------------
68! INCLUDE "comcstfi.h"
69
70      common/comcstfi/pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
71      common/comcstfi/avocado!,molrad,visc
72     
73      real pi,rad,g,r,cpp,rcp,dtphys,daysec,mugaz,omeg
74      real avocado!,molrad,visc
75
76!
77! For Fortran 77/Fortran 90 compliance always use line continuation
78! symbols '&' in columns 73 and 6
79!
80! Group commons according to their type for minimal performance impact
81
82      COMMON/callkeys_l/callrad,corrk,calldifv,UseTurbDiff,calladj      &
83     &   , co2cond,callsoil                                             &
84     &   , season,diurnal,tlocked,rings_shadow,lwrite                   &
85     &   , callstats,calleofdump                                        &
86     &   , enertest                                                     &
87     &   , callgasvis,continuum,H2Ocont_simple,graybody                 &
88     &   , radfixed                                                     &
89     &   , meanOLR, specOLR                                             &
90     &   , kastprof                                                     &
91     &   , nosurf, oblate                                               &     
92     &   , newtonian, testradtimes                                      &
93     &   , check_cpp_match, force_cpp                                   &
94     &   , rayleigh                                                     &
95     &   , stelbbody                                                    &
96     &   , nearco2cond                                                  &
97     &   , tracer, mass_redistrib, varactive, varfixed                  &
98     &   , sedimentation,water,watercond,waterrain                      &
99     &   , aeroco2,aeroh2o,aeroh2so4,aeroback2lay                       &
100     &   , aerofixco2,aerofixh2o                                        &
101     &   , hydrology, sourceevol                                        &
102     &   , CLFvarying                                                   &
103     &   , strictboundcorrk                                             &                                       
104     &   , ok_slab_ocean                                                &
105     &   , ok_slab_sic                                                  &
106     &   , ok_slab_heat_transp                                         
107
108
109      COMMON/callkeys_i/iaervar,iddist,iradia,startype
110     
111      COMMON/callkeys_r/topdustref,Nmix_co2,dusttau,Fat1AU,stelTbb,     &
112     &                  Tstrat,tplanet,obs_tau_col_tropo,               &
113     &                  obs_tau_col_strato,pres_bottom_tropo,           &
114     &                  pres_top_tropo,pres_bottom_strato,              &
115     &                  pres_top_strato,size_tropo,size_strato,satval,  &
116     &                  CLFfixval,n2mixratio,co2supsat,pceil,albedosnow,&
117     &                  maxicethick,Tsaldiff,tau_relax,cloudlvl,        &
118     &                  icetstep,intheat,flatten,Rmean,J2,MassPlanet
119     
120      logical callrad,corrk,calldifv,UseTurbDiff                        &
121     &   , calladj,co2cond,callsoil                                     &
122     &   , season,diurnal,tlocked,rings_shadow,lwrite                   &
123     &   , callstats,calleofdump                                        &
124     &   , callgasvis,continuum,H2Ocont_simple,graybody                 &
125     &   , strictboundcorrk                                             
126
127      logical enertest
128      logical nonideal
129      logical meanOLR
130      logical specOLR
131      logical kastprof
132      logical newtonian
133      logical check_cpp_match
134      logical force_cpp
135      logical testradtimes
136      logical rayleigh
137      logical stelbbody
138      logical ozone
139      logical nearco2cond
140      logical tracer
141      logical mass_redistrib
142      logical varactive
143      logical varfixed
144      logical radfixed
145      logical sedimentation
146      logical water,watercond,waterrain
147      logical aeroco2,aeroh2o,aeroh2so4,aeroback2lay
148      logical aerofixco2,aerofixh2o
149      logical hydrology
150      logical sourceevol
151      logical CLFvarying
152      logical nosurf
153      logical oblate
154      logical ok_slab_ocean
155      logical ok_slab_sic
156      logical ok_slab_heat_transp
157
158      integer iddist
159      integer iaervar
160      integer iradia
161      integer startype
162
163      real topdustref
164      real Nmix_co2
165      real dusttau
166      real Fat1AU
167      real stelTbb
168      real Tstrat
169      real tplanet
170      real obs_tau_col_tropo
171      real obs_tau_col_strato
172      real pres_bottom_tropo
173      real pres_top_tropo
174      real pres_bottom_strato
175      real pres_top_strato
176      real size_tropo
177      real size_strato
178      real satval
179      real CLFfixval
180      real n2mixratio
181      real co2supsat
182      real pceil
183      real albedosnow
184      real maxicethick
185      real Tsaldiff
186      real tau_relax
187      real cloudlvl
188      real icetstep
189      real intheat
190      real flatten
191      real Rmean
192      real J2
193      real MassPlanet
194
195      integer ngrid,nq
196
197!     Inputs
198!     ------
199      real albedoice
200      save albedoice
201
202      real snowlayer
203      parameter (snowlayer=33.0)        ! 33 kg/m^2 of snow, equal to a layer of 3.3 cm
204      real oceantime
205      parameter (oceantime=10*24*3600)
206
207      logical,save :: oceanbulkavg ! relax ocean temperatures to a GLOBAL mean value?
208      logical,save :: activerunoff ! enable simple runoff scheme?
209      logical,save :: oceanalbvary ! ocean albedo varies with the diurnal cycle?
210
211!     Arguments
212!     ---------
213      real rnat(ngrid) ! I changed this to integer (RW)
214      real,dimension(:),allocatable,save :: runoff
215      real totalrunoff, tsea, oceanarea
216      save oceanarea
217
218      real ptimestep
219      real mu0(ngrid)
220      real qsurf(ngrid,nq), tsurf(ngrid)
221      real dqsurf(ngrid,nq), pdtsurf(ngrid)
222      real hice(ngrid)
223      real albedo0(ngrid), albedo(ngrid)
224      real pctsrf_sic(ngrid), sea_ice(ngrid)
225
226      real oceanarea2
227
228!     Output
229!     ------
230      real dqs_hyd(ngrid,nq)
231      real pdtsurf_hyd(ngrid)
232
233!     Local
234!     -----
235      real a,b,E
236      integer ig,iq, icap ! wld like to remove icap
237      real fsnoi, subli, fauxo
238      real twater(ngrid)
239      real pcapcal(ngrid)
240      real hicebis(ngrid)
241      real zqsurf(ngrid,nq)
242      real ztsurf(ngrid)
243      real albedo_sic, alb_ice
244      real zfra
245
246      integer, save :: ivap, iliq, iice
247
248      logical, save :: firstcall
249
250      data firstcall /.true./
251
252
253      if(firstcall)then
254
255         oceanbulkavg=.false.
256         oceanalbvary=.false.
257         write(*,*)"Activate runnoff into oceans?"
258         activerunoff=.false.
259         call getin("activerunoff",activerunoff)
260         write(*,*)" activerunoff = ",activerunoff
261         
262         
263         
264         if (activerunoff) ALLOCATE(runoff(ngrid))
265
266         ivap=igcm_h2o_vap
267         iliq=igcm_h2o_vap
268         iice=igcm_h2o_ice
269       
270         write(*,*) "hydrol: ivap=",ivap
271         write(*,*) "        iliq=",iliq
272         write(*,*) "        iice=",iice
273
274!     Here's the deal: iice is used in place of igcm_h2o_ice both on the
275!                      surface and in the atmosphere. ivap is used in
276!                      place of igcm_h2o_vap ONLY in the atmosphere, while
277!                      iliq is used in place of igcm_h2o_vap ONLY on the
278!                      surface.
279
280!                      Soon to be extended to the entire water cycle...
281
282!     Ice albedo = snow albedo for now
283         albedoice=albedosnow
284
285!     Total ocean surface area
286         oceanarea=0.
287         do ig=1,ngrid
288            if(nint(rnat(ig)).eq.0)then
289               oceanarea=oceanarea+area(ig)
290            endif
291         enddo
292
293         if(oceanbulkavg.and.(oceanarea.le.0.))then
294            print*,'How are we supposed to average the ocean'
295            print*,'temperature, when there are no oceans?'
296            call abort
297         endif
298
299         if(activerunoff.and.(oceanarea.le.0.))then
300            print*,'You have enabled runoff, but you have no oceans.'
301            print*,'Where did you think the water was going to go?'
302            call abort
303         endif
304         
305         firstcall = .false.
306      endif
307
308!     add physical tendencies already calculated
309!     ------------------------------------------
310
311      do ig=1,ngrid
312         ztsurf(ig) = tsurf(ig) + ptimestep*pdtsurf(ig)
313         pdtsurf_hyd(ig)=0.0
314         do iq=1,nq
315            zqsurf(ig,iq) = qsurf(ig,iq) + ptimestep*dqsurf(ig,iq)
316         enddo   
317      enddo
318 
319      do ig=1,ngrid
320         do iq=1,nq
321            dqs_hyd(ig,iq) = 0.0
322         enddo
323      enddo
324
325      do ig = 1, ngrid
326
327!     Ocean
328!     -----
329         if(nint(rnat(ig)).eq.0)then
330
331!     re-calculate oceanic albedo
332!            if(diurnal.and.oceanalbvary)then
333!               fauxo      = ( 1.47 - ACOS( mu0(ig) ) )/0.15 ! where does this come from (Benjamin)?
334!               albedo(ig) = 1.1*( .03 + .630/( 1. + fauxo*fauxo))
335!               albedo(ig) = MAX(MIN(albedo(ig),0.60),0.04)
336!            else
337               albedo(ig) = alb_ocean ! modif Benjamin
338!            end if
339
340
341          if(ok_slab_ocean) then
342
343! Fraction neige (hauteur critique 45kg/m2~15cm)
344            zfra = MAX(0.0,MIN(1.0,zqsurf(ig,iice)/45.0))
345! Albedo glace
346            alb_ice=alb_ice_max-(alb_ice_max-alb_ice_min) &
347            *exp(-sea_ice(ig)/h_alb_ice)
348! Albedo glace+neige
349            albedo_sic= albedosnow*zfra + alb_ice*(1.0-zfra)
350
351! Albedo final
352            albedo(ig) = pctsrf_sic(ig)*albedo_sic + (1.-pctsrf_sic(ig))*alb_ocean
353!     oceanic ice height, just for diagnostics
354            hice(ig)    = MIN(10.,sea_ice(ig)/rhowater)
355          else !ok_slab_ocean
356
357
358!     calculate oceanic ice height including the latent heat of ice formation
359!     hice is the height of oceanic ice with a maximum of maxicethick.
360            hice(ig)    = zqsurf(ig,iice)/rhowater ! update hice to include recent snowfall
361
362!            twater(ig)  = tsurf(ig) + ptimestep*zdtsurf(ig) &
363            twater(ig)  = ztsurf(ig) - hice(ig)*RLFTT*rhowater/pcapcal(ig)
364            ! this is temperature water would have if we melted entire ocean ice layer
365            hicebis(ig) = hice(ig)
366            hice(ig)    = 0.
367
368            if(twater(ig) .lt. T_h2O_ice_liq)then
369               E=min((T_h2O_ice_liq+Tsaldiff-twater(ig))*pcapcal(ig),RLFTT*rhowater*maxicethick)
370               hice(ig)        = E/(RLFTT*rhowater)
371               hice(ig)        = max(hice(ig),0.0)
372               hice(ig)        = min(hice(ig),maxicethick)
373               pdtsurf_hyd(ig) = (hice(ig) - hicebis(ig))*RLFTT*rhowater/pcapcal(ig)/ptimestep             
374               albedo(ig)      = albedoice
375
376!               if (zqsurf(ig,iice).ge.snowlayer) then
377!                  albedo(ig) = albedoice
378!               else
379!                  albedo(ig) = albedoocean &
380!                       + (albedosnow - albedoocean)*zqsurf(ig,iice)/snowlayer
381!               endif
382
383            else
384
385               pdtsurf_hyd(ig) = -hicebis(ig)*RLFTT*rhowater/pcapcal(ig)/ptimestep               
386               albedo(ig)      = alb_ocean
387
388            endif
389
390            zqsurf(ig,iliq) = zqsurf(ig,iliq)-(hice(ig)*rhowater-zqsurf(ig,iice))
391            zqsurf(ig,iice) = hice(ig)*rhowater
392
393          endif!(ok_slab_ocean)
394
395
396!     Continent
397!     ---------
398         elseif (nint(rnat(ig)).eq.1) then
399
400!     melt the snow
401            if(ztsurf(ig).gt.T_h2O_ice_liq)then
402               if(zqsurf(ig,iice).gt.1.0e-8)then
403
404                  a     = (ztsurf(ig)-T_h2O_ice_liq)*pcapcal(ig)/RLFTT
405                  b     = zqsurf(ig,iice)
406                  fsnoi = min(a,b)
407
408                  zqsurf(ig,iice) = zqsurf(ig,iice) - fsnoi
409                  zqsurf(ig,iliq) = zqsurf(ig,iliq) + fsnoi
410
411!                 thermal effects
412                  pdtsurf_hyd(ig) = -fsnoi*RLFTT/pcapcal(ig)/ptimestep 
413
414               endif
415            else
416
417!     freeze the water
418               if(zqsurf(ig,iliq).gt.1.0e-8)then
419
420                  a     = -(ztsurf(ig)-T_h2O_ice_liq)*pcapcal(ig)/RLFTT
421                  b     = zqsurf(ig,iliq)
422                 
423                  fsnoi = min(a,b)
424
425                  zqsurf(ig,iice) = zqsurf(ig,iice) + fsnoi
426                  zqsurf(ig,iliq) = zqsurf(ig,iliq) - fsnoi
427
428!                 thermal effects
429                  pdtsurf_hyd(ig) = +fsnoi*RLFTT/pcapcal(ig)/ptimestep 
430
431               endif
432            endif
433           
434!     deal with runoff
435            if(activerunoff)then
436
437               runoff(ig) = max(zqsurf(ig,iliq) - mx_eau_sol, 0.0)
438               if(ngrid.gt.1)then ! runoff only exists in 3D
439                  if(runoff(ig).ne.0.0)then
440                     zqsurf(ig,iliq) = mx_eau_sol
441!                    runoff is added to ocean at end
442                  endif
443               end if
444
445            endif
446
447!     re-calculate continental albedo
448            albedo(ig) = albedo0(ig) ! albedo0 = base values
449            if (zqsurf(ig,iice).ge.snowlayer) then
450               albedo(ig) = albedosnow
451            else
452               albedo(ig) = albedo0(ig) &
453                    + (albedosnow - albedo0(ig))*zqsurf(ig,iice)/snowlayer
454            endif
455
456         else
457
458            print*,'Surface type not recognised in hydrol.F!'
459            print*,'Exiting...'
460            call abort
461
462         endif
463
464      end do ! ig=1,ngrid
465
466!     perform crude bulk averaging of temperature in ocean
467!     ----------------------------------------------------
468      if(oceanbulkavg)then
469
470         oceanarea2=0.       
471         DO ig=1,ngrid
472            if((nint(rnat(ig)).eq.0).and.(hice(ig).eq.0.))then
473               oceanarea2=oceanarea2+area(ig)*pcapcal(ig)
474            end if
475         END DO
476       
477         tsea=0.
478         DO ig=1,ngrid
479            if((nint(rnat(ig)).eq.0).and.(hice(ig).eq.0.))then       
480               tsea=tsea+ztsurf(ig)*area(ig)*pcapcal(ig)/oceanarea2
481            end if
482         END DO
483
484         DO ig=1,ngrid
485            if((nint(rnat(ig)).eq.0).and.(hice(ig).eq.0))then
486               pdtsurf_hyd(ig) = pdtsurf_hyd(ig) + (tsea-ztsurf(ig))/oceantime
487            end if
488         END DO
489
490         print*,'Mean ocean temperature               = ',tsea,' K'
491
492      endif
493
494!     shove all the runoff water into the ocean
495!     -----------------------------------------
496      if(activerunoff)then
497
498         totalrunoff=0.
499         do ig=1,ngrid
500            if (nint(rnat(ig)).eq.1) then
501               totalrunoff = totalrunoff + area(ig)*runoff(ig)
502            endif
503         enddo
504         
505         do ig=1,ngrid
506            if (nint(rnat(ig)).eq.0) then
507               zqsurf(ig,iliq) = zqsurf(ig,iliq) + &
508                    totalrunoff/oceanarea
509            endif
510         enddo
511
512      endif         
513
514
515!     Re-add the albedo effects of CO2 ice if necessary
516!     -------------------------------------------------
517      if(co2cond)then
518
519         icap=1
520         do ig=1,ngrid
521            if (qsurf(ig,igcm_co2_ice).gt.0) then
522               albedo(ig) = albedice(icap)
523            endif
524         enddo
525         
526      endif
527
528
529      do ig=1,ngrid
530         dqs_hyd(ig,iliq)=(zqsurf(ig,iliq) - qsurf(ig,iliq))/ptimestep
531         dqs_hyd(ig,iice)=(zqsurf(ig,iice) - qsurf(ig,iice))/ptimestep
532      enddo
533
534      if (activerunoff) then
535        call writediagfi(ngrid,'runoff','Runoff amount',' ',2,runoff)
536      endif
537
538      return
539    end subroutine hydrol
Note: See TracBrowser for help on using the repository browser.