My Project
 All Classes Files Functions Variables Macros
cv3p1_closure.F
Go to the documentation of this file.
1 !
2 ! $Id: cv3p1_closure.F 1574 2011-09-20 12:09:47Z jghattas $
3 !
4  SUBROUTINE cv3p1_closure(nloc,ncum,nd,icb,inb
5  : ,pbase,plcl,p,ph,tv,tvp,buoy
6  : ,supmax,ok_inhib,ale,alp
7  o ,sig,w0,ptop2,cape,cin,m,iflag,coef
8  : ,plim1,plim2,asupmax,supmax0
9  : ,asupmaxmin,cbmf,plfc,wbeff)
10 
11 *
12 ***************************************************************
13 * *
14 * CV3P1_CLOSURE *
15 * Ale & Alp Closure of Convect3 *
16 * *
17 * written by : Kerry Emanuel *
18 * vectorization: S. Bony *
19 * modified by : Jean-Yves Grandpeix, 18/06/2003, 19.32.10 *
20 * Julie Frohwirth, 14/10/2005 17.44.22 *
21 ***************************************************************
22 *
23  implicit none
24 
25 #include "cvthermo.h"
26 #include "cv3param.h"
27 #include "YOMCST2.h"
28 #include "YOMCST.h"
29 #include "conema3.h"
30 #include "iniprint.h"
31 
32 c input:
33  integer ncum, nd, nloc
34  integer icb(nloc), inb(nloc)
35  real pbase(nloc),plcl(nloc)
36  real p(nloc,nd), ph(nloc,nd+1)
37  real tv(nloc,nd),tvp(nloc,nd), buoy(nloc,nd)
38  real supmax(nloc,nd)
39  logical ok_inhib ! enable convection inhibition by dryness
40  real ale(nloc),alp(nloc)
41 
42 c input/output:
43  real sig(nloc,nd), w0(nloc,nd), ptop2(nloc)
44 
45 c output:
46  real cape(nloc),cin(nloc)
47  real m(nloc,nd)
48  real plim1(nloc),plim2(nloc)
49  real asupmax(nloc,nd),supmax0(nloc)
50  real asupmaxmin(nloc)
51  real cbmf(nloc),plfc(nloc)
52  real wbeff(nloc)
53  integer iflag(nloc)
54 c
55 c local variables:
56  integer il, i, j, k, icbmax, i0(nloc)
57  real deltap, fac, w, amu
58  real rhodp
59  real pbmxup
60  real dtmin(nloc,nd), sigold(nloc,nd)
61  real coefmix(nloc,nd)
62  real pzero(nloc),ptop2old(nloc)
63  real cina(nloc),cinb(nloc)
64  integer ibeg(nloc)
65  integer nsupmax(nloc)
66  real supcrit,temp(nloc,nd)
67  real p1(nloc),pmin(nloc)
68  real asupmax0(nloc)
69  logical ok(nloc)
70  real siglim(nloc,nd),wlim(nloc,nd),mlim(nloc,nd)
71  real wb2(nloc)
72  real cbmflim(nloc),cbmf1(nloc),cbmfmax(nloc)
73  real cbmflast(nloc)
74  real coef(nloc)
75  real xp(nloc),xq(nloc),xr(nloc),discr(nloc),b3(nloc),b4(nloc)
76  real theta(nloc),bb(nloc)
77  real term1,term2,term3
78  real alp2(nloc) ! Alp with offset
79 c
80  real sigmax
81  parameter(sigmax = 0.1)
82 
83  CHARACTER (LEN=20) :: modname='cv3p1_closure'
84  CHARACTER (LEN=80) :: abort_message
85 c
86 c print *,' -> cv3p1_closure, Ale ',ale(1)
87 c
88 
89 c -------------------------------------------------------
90 c -- Initialization
91 c -------------------------------------------------------
92 
93 c
94 c
95  do il = 1,ncum
96  alp2(il) = max(alp(il),1.e-5)
97 cIM
98  alp2(il) = max(alp(il),1.e-12)
99  enddo
100 c
101  pbmxup=50. ! PBMXUP+PBCRIT = cloud depth above which mixed updraughts
102 c exist (if any)
103 
104  if(prt_level.GE.20)
105  . print*,'cv3p1_param nloc ncum nd icb inb nl',nloc,ncum,nd,
106  . icb(nloc),inb(nloc),nl
107  do k=1,nl
108  do il=1,ncum
109  m(il,k)=0.0
110  enddo
111  enddo
112 
113 c -------------------------------------------------------
114 c -- Reset sig(i) and w0(i) for i>inb and i<icb
115 c -------------------------------------------------------
116 
117 c update sig and w0 above LNB:
118 
119  do 100 k=1,nl-1
120  do 110 il=1,ncum
121  if ((inb(il).lt.(nl-1)).and.(k.ge.(inb(il)+1)))then
122  sig(il,k)=beta*sig(il,k)
123  : +2.*alpha*buoy(il,inb(il))*abs(buoy(il,inb(il)))
124  sig(il,k)=amax1(sig(il,k),0.0)
125  w0(il,k)=beta*w0(il,k)
126  endif
127  110 continue
128  100 continue
129 
130 c if(prt.level.GE.20) print*,'cv3p1_param apres 100'
131 c compute icbmax:
132 
133  icbmax=2
134  do 200 il=1,ncum
135  icbmax=max(icbmax,icb(il))
136  200 continue
137 ! if(prt.level.GE.20) print*,'cv3p1_param apres 200'
138 
139 c update sig and w0 below cloud base:
140 
141  do 300 k=1,icbmax
142  do 310 il=1,ncum
143  if (k.le.icb(il))then
144  sig(il,k)=beta*sig(il,k)-2.*alpha*buoy(il,icb(il))
145  $ *buoy(il,icb(il))
146  sig(il,k)=amax1(sig(il,k),0.0)
147  w0(il,k)=beta*w0(il,k)
148  endif
149 310 continue
150 300 continue
151  if(prt_level.GE.20) print*,'cv3p1_param apres 300'
152 c -------------------------------------------------------------
153 c -- Reset fractional areas of updrafts and w0 at initial time
154 c -- and after 10 time steps of no convection
155 c -------------------------------------------------------------
156 
157  do 400 k=1,nl-1
158  do 410 il=1,ncum
159  if (sig(il,nd).lt.1.5.or.sig(il,nd).gt.12.0)then
160  sig(il,k)=0.0
161  w0(il,k)=0.0
162  endif
163  410 continue
164  400 continue
165  if(prt_level.GE.20) print*,'cv3p1_param apres 400'
166 c
167 c -------------------------------------------------------------
168 Cjyg1
169 C -- Calculate adiabatic ascent top pressure (ptop)
170 c -------------------------------------------------------------
171 C
172 c
173 cc 1. Start at first level where precipitations form
174  do il = 1,ncum
175  pzero(il) = plcl(il)-pbcrit
176  enddo
177 c
178 cc 2. Add offset
179  do il = 1,ncum
180  pzero(il) = pzero(il)-pbmxup
181  enddo
182  do il=1,ncum
183  ptop2old(il)=ptop2(il)
184  enddo
185 c
186  do il = 1,ncum
187 cCR:c est quoi ce 300??
188  p1(il) = pzero(il)-300.
189  enddo
190 
191 c compute asupmax=abs(supmax) up to lnm+1
192 
193  DO il=1,ncum
194  ok(il)=.true.
195  nsupmax(il)=inb(il)
196  ENDDO
197 
198  DO i = 1,nl
199  DO il = 1,ncum
200  IF (i .GT. icb(il) .AND. i .LE. inb(il)) THEN
201  IF (p(il,i) .LE. pzero(il) .and.
202  $ supmax(il,i) .lt. 0 .and. ok(il)) THEN
203  nsupmax(il)=i
204  ok(il)=.false.
205  ENDIF ! end IF (P(i) ... )
206  ENDIF ! end IF (icb+1 le i le inb)
207  ENDDO
208  ENDDO
209 
210  if(prt_level.GE.20) print*,'cv3p1_param apres 2.'
211  DO i = 1,nl
212  DO il = 1,ncum
213  asupmax(il,i)=abs(supmax(il,i))
214  ENDDO
215  ENDDO
216 
217 c
218  DO il = 1,ncum
219  asupmaxmin(il)=10.
220  pmin(il)=100.
221 !IM ??
222  asupmax0(il)=0.
223  ENDDO
224 
225 cc 3. Compute in which level is Pzero
226 
227 cIM bug i0 = 18
228  DO il = 1,ncum
229  i0(il) = nl
230  ENDDO
231 
232  DO i = 1,nl
233  DO il = 1,ncum
234  IF (i .GT. icb(il) .AND. i .LE. inb(il)) THEN
235  IF (p(il,i) .LE. pzero(il) .AND. p(il,i) .GE. p1(il)) THEN
236  IF (pzero(il) .GT. p(il,i) .AND.
237  $ pzero(il) .LT. p(il,i-1)) THEN
238  i0(il) = i
239  ENDIF
240  ENDIF
241  ENDIF
242  ENDDO
243  ENDDO
244  if(prt_level.GE.20) print*,'cv3p1_param apres 3.'
245 
246 cc 4. Compute asupmax at Pzero
247 
248  DO i = 1,nl
249  DO il = 1,ncum
250  IF (i .GT. icb(il) .AND. i .LE. inb(il)) THEN
251  IF (p(il,i) .LE. pzero(il) .AND. p(il,i) .GE. p1(il)) THEN
252  asupmax0(il) =
253  $ ((pzero(il)-p(il,i0(il)-1))*asupmax(il,i0(il))
254  $ -(pzero(il)-p(il,i0(il)))*asupmax(il,i0(il)-1))
255  $ /(p(il,i0(il))-p(il,i0(il)-1))
256  ENDIF
257  ENDIF
258  ENDDO
259  ENDDO
260 
261 
262  DO i = 1,nl
263  DO il = 1,ncum
264  IF (p(il,i) .EQ. pzero(il)) THEN
265  asupmax(i,il) = asupmax0(il)
266  ENDIF
267  ENDDO
268  ENDDO
269  if(prt_level.GE.20) print*,'cv3p1_param apres 4.'
270 
271 cc 5. Compute asupmaxmin, minimum of asupmax
272 
273  DO i = 1,nl
274  DO il = 1,ncum
275  IF (i .GT. icb(il) .AND. i .LE. inb(il)) THEN
276  IF (p(il,i) .LE. pzero(il) .AND. p(il,i) .GE. p1(il)) THEN
277  IF (asupmax(il,i) .LT. asupmaxmin(il)) THEN
278  asupmaxmin(il)=asupmax(il,i)
279  pmin(il)=p(il,i)
280  ENDIF
281  ENDIF
282  ENDIF
283  ENDDO
284  ENDDO
285 
286  DO il = 1,ncum
287 !IM
288  if(prt_level.GE.20) THEN
289  print*,'cv3p1_closure il asupmax0 asupmaxmin',il,asupmax0(il),
290  $ asupmaxmin(il) ,pzero(il),pmin(il)
291  endif
292  IF (asupmax0(il) .LT. asupmaxmin(il)) THEN
293  asupmaxmin(il) = asupmax0(il)
294  pmin(il) = pzero(il)
295  ENDIF
296  ENDDO
297  if(prt_level.GE.20) print*,'cv3p1_param apres 5.'
298 
299 c
300 c Compute Supmax at Pzero
301 c
302  DO i = 1,nl
303  DO il = 1,ncum
304  IF (i .GT. icb(il) .AND. i .LE. inb(il)) THEN
305  IF (p(il,i) .LE. pzero(il)) THEN
306  supmax0(il) = ((p(il,i )-pzero(il))*asupmax(il,i-1)
307  $ -(p(il,i-1)-pzero(il))*asupmax(il,i ))
308  $ /(p(il,i)-p(il,i-1))
309  go to 425
310  ENDIF ! end IF (P(i) ... )
311  ENDIF ! end IF (icb+1 le i le inb)
312  ENDDO
313  ENDDO
314 
315 425 continue
316  if(prt_level.GE.20) print*,'cv3p1_param apres 425.'
317 
318 cc 6. Calculate ptop2
319 c
320  DO il = 1,ncum
321  IF (asupmaxmin(il) .LT. supcrit1) THEN
322  ptop2(il) = pmin(il)
323  ENDIF
324 
325  IF (asupmaxmin(il) .GT. supcrit1
326  $ .AND. asupmaxmin(il) .LT. supcrit2) THEN
327  ptop2(il) = ptop2old(il)
328  ENDIF
329 
330  IF (asupmaxmin(il) .GT. supcrit2) THEN
331  ptop2(il) = ph(il,inb(il))
332  ENDIF
333  ENDDO
334 c
335  if(prt_level.GE.20) print*,'cv3p1_param apres 6.'
336 
337 cc 7. Compute multiplying factor for adiabatic updraught mass flux
338 c
339 c
340  IF (ok_inhib) THEN
341 c
342  DO i = 1,nl
343  DO il = 1,ncum
344  IF (i .le. nl) THEN
345  coefmix(il,i) = (min(ptop2(il),ph(il,i))-ph(il,i))
346  $ /(ph(il,i+1)-ph(il,i))
347  coefmix(il,i) = min(coefmix(il,i),1.)
348  ENDIF
349  ENDDO
350  ENDDO
351 c
352 c
353  ELSE ! when inhibition is not taken into account, coefmix=1
354 c
355 
356 c
357  DO i = 1,nl
358  DO il = 1,ncum
359  IF (i .le. nl) THEN
360  coefmix(il,i) = 1.
361  ENDIF
362  ENDDO
363  ENDDO
364 c
365  ENDIF ! ok_inhib
366  if(prt_level.GE.20) print*,'cv3p1_param apres 7.'
367 c -------------------------------------------------------------------
368 c -------------------------------------------------------------------
369 c
370 
371 Cjyg2
372 C
373 c==========================================================================
374 C
375 c
376 c -------------------------------------------------------------
377 c -- Calculate convective inhibition (CIN)
378 c -------------------------------------------------------------
379 
380 c do i=1,nloc
381 c print*,'avant cine p',pbase(i),plcl(i)
382 c enddo
383 c do j=1,nd
384 c do i=1,nloc
385 c print*,'avant cine t',tv(i),tvp(i)
386 c enddo
387 c enddo
388  CALL cv3_cine(nloc,ncum,nd,icb,inb
389  : ,pbase,plcl,p,ph,tv,tvp
390  : ,cina,cinb,plfc)
391 c
392  DO il = 1,ncum
393  cin(il) = cina(il)+cinb(il)
394  ENDDO
395  if(prt_level.GE.20) print*,'cv3p1_param apres cv3_cine'
396 c -------------------------------------------------------------
397 c --Update buoyancies to account for Ale
398 c -------------------------------------------------------------
399 c
400  CALL cv3_buoy(nloc,ncum,nd,icb,inb
401  : ,pbase,plcl,p,ph,ale,cin
402  : ,tv,tvp
403  : ,buoy )
404  if(prt_level.GE.20) print*,'cv3p1_param apres cv3_buoy'
405 
406 c -------------------------------------------------------------
407 c -- Calculate convective available potential energy (cape),
408 c -- vertical velocity (w), fractional area covered by
409 c -- undilute updraft (sig), and updraft mass flux (m)
410 c -------------------------------------------------------------
411 
412  do 500 il=1,ncum
413  cape(il)=0.0
414  500 continue
415 
416 c compute dtmin (minimum buoyancy between ICB and given level k):
417 
418  do k=1,nl
419  do il=1,ncum
420  dtmin(il,k)=100.0
421  enddo
422  enddo
423 
424  do 550 k=1,nl
425  do 560 j=minorig,nl
426  do 570 il=1,ncum
427  if ( (k.ge.(icb(il)+1)).and.(k.le.inb(il)).and.
428  : (j.ge.icb(il)).and.(j.le.(k-1)) )then
429  dtmin(il,k)=amin1(dtmin(il,k),buoy(il,j))
430  endif
431  570 continue
432  560 continue
433  550 continue
434 
435 c the interval on which cape is computed starts at pbase :
436 
437  do 600 k=1,nl
438  do 610 il=1,ncum
439 
440  if ((k.ge.(icb(il)+1)).and.(k.le.inb(il))) then
441 
442  deltap = min(pbase(il),ph(il,k-1))-min(pbase(il),ph(il,k))
443  cape(il)=cape(il)+rrd*buoy(il,k-1)*deltap/p(il,k-1)
444  cape(il)=amax1(0.0,cape(il))
445  sigold(il,k)=sig(il,k)
446 
447 
448 cjyg Coefficient coefmix limits convection to levels where a sufficient
449 c fraction of mixed draughts are ascending.
450  siglim(il,k)=coefmix(il,k)*alpha1*dtmin(il,k)*abs(dtmin(il,k))
451  siglim(il,k)=amax1(siglim(il,k),0.0)
452  siglim(il,k)=amin1(siglim(il,k),0.01)
453 cc fac=AMIN1(((dtcrit-dtmin(il,k))/dtcrit),1.0)
454  fac = 1.
455  wlim(il,k)=fac*sqrt(cape(il))
456  amu=siglim(il,k)*wlim(il,k)
457  rhodp = 0.007*p(il,k)*(ph(il,k)-ph(il,k+1))/tv(il,k)
458  mlim(il,k)=amu*rhodp
459 c print*, 'siglim ', k,siglim(1,k)
460  endif
461 
462  610 continue
463  600 continue
464  if(prt_level.GE.20) print*,'cv3p1_param apres 600'
465 
466  do 700 il=1,ncum
467 !IM beg
468  if(prt_level.GE.20) THEN
469  print*,'cv3p1_closure il icb mlim ph ph+1 ph+2',il,
470  $icb(il),mlim(il,icb(il)+1),ph(il,icb(il)),
471  $ph(il,icb(il)+1),ph(il,icb(il)+2)
472  endif
473 
474  if (icb(il)+1.le.inb(il)) then
475 !IM end
476  mlim(il,icb(il))=0.5*mlim(il,icb(il)+1)
477  : *(ph(il,icb(il))-ph(il,icb(il)+1))
478  : /(ph(il,icb(il)+1)-ph(il,icb(il)+2))
479 !IM beg
480  endif !(icb(il.le.inb(il))) then
481 !IM end
482  700 continue
483  if(prt_level.GE.20) print*,'cv3p1_param apres 700'
484 
485 cjyg1
486 c------------------------------------------------------------------------
487 cc Correct mass fluxes so that power used to overcome CIN does not
488 cc exceed Power Available for Lifting (PAL).
489 c------------------------------------------------------------------------
490 c
491  do il = 1,ncum
492  cbmflim(il) = 0.
493  cbmf(il) = 0.
494  enddo
495 c
496 cc 1. Compute cloud base mass flux of elementary system (Cbmf0=Cbmflim)
497 c
498  do k= 1,nl
499  do il = 1,ncum
500 !old IF (k .ge. icb(il) .and. k .le. inb(il)) THEN
501 !IM IF (k .ge. icb(il)+1 .and. k .le. inb(il)) THEN
502  IF (k .ge. icb(il) .and. k .le. inb(il) !cor jyg
503  $ .and. icb(il)+1 .le. inb(il)) THEN !cor jyg
504  cbmflim(il) = cbmflim(il)+mlim(il,k)
505  ENDIF
506  enddo
507  enddo
508  if(prt_level.GE.20) print*,'cv3p1_param apres cbmflim'
509 
510 cc 1.5 Compute cloud base mass flux given by Alp closure (Cbmf1), maximum
511 cc allowed mass flux (Cbmfmax) and final target mass flux (Cbmf)
512 cc Cbmf is set to zero if Cbmflim (the mass flux of elementary cloud) is
513 c-- exceedingly small.
514 c
515  DO il = 1,ncum
516  wb2(il) = sqrt(2.*max(ale(il)+cin(il),0.))
517  ENDDO
518 
519  DO il = 1, ncum
520  IF (plfc(il) .lt. 100.) THEN
521 c This is an irealistic value for plfc => no calculation of wbeff
522  wbeff(il) = 100.1
523  ELSE
524 c Calculate wbeff
525  IF (flag_wb==0) THEN
526  wbeff(il) = wbmax
527  ELSE IF (flag_wb==1) THEN
528  wbeff(il) = wbmax/(1.+500./(ph(il,1)-plfc(il)))
529  ELSE IF (flag_wb==2) THEN
530  wbeff(il) = wbmax*(0.01*(ph(il,1)-plfc(il)))**2
531  ENDIF
532  END IF
533  END DO
534 
535 
536  DO il = 1,ncum
537 cjyg Modification du coef de wb*wb pour conformite avec papier Wake
538 cc cbmf1(il) = alp2(il)/(0.5*wb*wb-Cin(il))
539  cbmf1(il) = alp2(il)/(2.*wbeff(il)*wbeff(il)-cin(il))
540  if(cbmf1(il).EQ.0.AND.alp2(il).NE.0.) THEN
541  write(lunout,*)
542  & 'cv3p1_closure cbmf1=0 and alp NE 0 il alp2 alp cin ',il,
543  . alp2(il),alp(il),cin(il)
544  abort_message = ''
545  CALL abort_gcm(modname,abort_message,1)
546  endif
547  cbmfmax(il) = sigmax*wb2(il)*100.*p(il,icb(il))
548  : /(rrd*tv(il,icb(il)))
549  ENDDO
550 c
551  DO il = 1,ncum
552  IF (cbmflim(il) .gt. 1.e-6) THEN
553 cATTENTION TEST CR
554 c if (cbmfmax(il).lt.1.e-12) then
555  cbmf(il) = min(cbmf1(il),cbmfmax(il))
556 c else
557 c cbmf(il) = cbmf1(il)
558 c endif
559 c print*,'cbmf',cbmf1(il),cbmfmax(il)
560  ENDIF
561  ENDDO
562  if(prt_level.GE.20) print*,'cv3p1_param apres cbmflim_testCR'
563 c
564 cc 2. Compute coefficient and apply correction
565 c
566  do il = 1,ncum
567  coef(il) = (cbmf(il)+1.e-10)/(cbmflim(il)+1.e-10)
568  enddo
569  if(prt_level.GE.20) print*,'cv3p1_param apres coef_plantePLUS'
570 c
571  DO k = 1,nl
572  do il = 1,ncum
573  IF ( k .ge. icb(il)+1 .AND. k .le. inb(il)) THEN
574  amu=beta*sig(il,k)*w0(il,k)+
575  : (1.-beta)*coef(il)*siglim(il,k)*wlim(il,k)
576  w0(il,k) = wlim(il,k)
577  w0(il,k) =max(w0(il,k),1.e-10)
578  sig(il,k)=amu/w0(il,k)
579  sig(il,k)=min(sig(il,k),1.)
580 cc amu = 0.5*(SIG(il,k)+sigold(il,k))*W0(il,k)
581  m(il,k)=amu*0.007*p(il,k)*(ph(il,k)-ph(il,k+1))/tv(il,k)
582  ENDIF
583  enddo
584  ENDDO
585 cjyg2
586  DO il = 1,ncum
587  w0(il,icb(il))=0.5*w0(il,icb(il)+1)
588  m(il,icb(il))=0.5*m(il,icb(il)+1)
589  $ *(ph(il,icb(il))-ph(il,icb(il)+1))
590  $ /(ph(il,icb(il)+1)-ph(il,icb(il)+2))
591  sig(il,icb(il))=sig(il,icb(il)+1)
592  sig(il,icb(il)-1)=sig(il,icb(il))
593  ENDDO
594  if(prt_level.GE.20) print*,'cv3p1_param apres w0_sig_M'
595 c
596 cc 3. Compute final cloud base mass flux and set iflag to 3 if
597 cc cloud base mass flux is exceedingly small and is decreasing (i.e. if
598 cc the final mass flux (cbmflast) is greater than the target mass flux
599 cc (cbmf)).
600 c
601  do il = 1,ncum
602  cbmflast(il) = 0.
603  enddo
604 c
605  do k= 1,nl
606  do il = 1,ncum
607  IF (k .ge. icb(il) .and. k .le. inb(il)) THEN
608  !IMpropo?? IF ((k.ge.(icb(il)+1)).and.(k.le.inb(il))) THEN
609  cbmflast(il) = cbmflast(il)+m(il,k)
610  ENDIF
611  enddo
612  enddo
613 c
614  do il = 1,ncum
615  IF (cbmflast(il) .lt. 1.e-6 .and.
616  $ cbmflast(il) .ge. cbmf(il)) THEN
617  iflag(il) = 3
618  ENDIF
619  enddo
620 c
621  do k= 1,nl
622  do il = 1,ncum
623  IF (iflag(il) .ge. 3) THEN
624  m(il,k) = 0.
625  sig(il,k) = 0.
626  w0(il,k) = 0.
627  ENDIF
628  enddo
629  enddo
630  if(prt_level.GE.20) print*,'cv3p1_param apres iflag'
631 c
632 cc 4. Introduce a correcting factor for coef, in order to obtain an effective
633 cc sigdz larger in the present case (using cv3p1_closure) than in the old
634 cc closure (using cv3_closure).
635  if (1.eq.0) then
636  do il = 1,ncum
637 cc coef(il) = 2.*coef(il)
638  coef(il) = 5.*coef(il)
639  enddo
640 c version CVS du ..2008
641  else
642  if (iflag_cvl_sigd.eq.0) then
643 ctest pour verifier qu on fait la meme chose qu avant: sid constant
644  coef(1:ncum)=1.
645  else
646  coef(1:ncum) = min(2.*coef(1:ncum),5.)
647  coef(1:ncum) = max(2.*coef(1:ncum),0.2)
648  endif
649  endif
650 c
651  if(prt_level.GE.20) print*,'cv3p1_param FIN'
652  return
653  end
654 
655