From 11101bb6e990c08ea98b8aab2d417ab2773dce24 Mon Sep 17 00:00:00 2001 From: SebastienRietteMTO <77663714+SebastienRietteMTO@users.noreply.github.com> Date: Fri, 5 Apr 2024 14:24:50 +0000 Subject: [PATCH] =?UTF-8?q?Deploying=20to=20gh-pages=20from=20@=20UMR-CNRM?= =?UTF-8?q?/PHYEX@ec18f73bcbda41cce7858c0ca509fbf947453019=20=F0=9F=9A=80?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- .../html/main__ice__adjust_8F90_source.html | 2 +- doxygen/html/main__rain__ice_8F90_source.html | 2 +- .../main__rain__ice__old_8F90_source.html | 2 +- doxygen/html/main__shallow_8F90_source.html | 2 +- doxygen/html/main__turb_8F90_source.html | 2 +- ...ce4__sedimentation__split_8F90_source.html | 733 +++++++++--------- 6 files changed, 370 insertions(+), 373 deletions(-) diff --git a/doxygen/html/main__ice__adjust_8F90_source.html b/doxygen/html/main__ice__adjust_8F90_source.html index 90f9b6d8..7bc2f4a1 100644 --- a/doxygen/html/main__ice__adjust_8F90_source.html +++ b/doxygen/html/main__ice__adjust_8F90_source.html @@ -277,7 +277,7 @@
205 #if defined(USE_COLCALL) && defined(_OPENACC)
206  !Due to the collapse (2) directive, each point must have its own stack
207  ylstack%L = loc(pstack(1, ibl)) + ceiling(istsz * kind(pstack) / nproma / 8.) * 8 * (jlon - 1)
-
208  ylstack%U = ylstack%L + ceiling(istsz * kind(pstack) / nproma / 8.) * 8
+
208  ylstack%U = ylstack%L + floor(istsz * kind(pstack) / nproma / 8.) * 8
209 #else
210  ylstack%L = loc(pstack(1, ibl))
211  ylstack%U = ylstack%L + istsz * kind(pstack)
diff --git a/doxygen/html/main__rain__ice_8F90_source.html b/doxygen/html/main__rain__ice_8F90_source.html index 2f173741..485da40c 100644 --- a/doxygen/html/main__rain__ice_8F90_source.html +++ b/doxygen/html/main__rain__ice_8F90_source.html @@ -277,7 +277,7 @@
205 #if defined(USE_COLCALL) && defined(_OPENACC)
206  !Due to the collapse (2) directive, each point must have its own stack
207  ylstack%L = loc(pstack(1, ibl)) + ceiling(istsz * kind(pstack) / nproma / 8.) * 8 * (jlon - 1)
-
208  ylstack%U = ylstack%L + ceiling(istsz * kind(pstack) / nproma / 8.) * 8
+
208  ylstack%U = ylstack%L + floor(istsz * kind(pstack) / nproma / 8.) * 8
209 #else
210  ylstack%L = loc(pstack(1, ibl))
211  ylstack%U = ylstack%L + istsz * kind(pstack)
diff --git a/doxygen/html/main__rain__ice__old_8F90_source.html b/doxygen/html/main__rain__ice__old_8F90_source.html index 36bfe45b..b7ac04cd 100644 --- a/doxygen/html/main__rain__ice__old_8F90_source.html +++ b/doxygen/html/main__rain__ice__old_8F90_source.html @@ -345,7 +345,7 @@
273 #if defined(USE_COLCALL) && defined(_OPENACC)
274  !Due to the collapse (2) directive, each point must have its own stack
275  ylstack%L = loc(pstack(1, ibl)) + ceiling(istsz * kind(pstack) / nproma / 8.) * 8 * (jlon - 1)
-
276  ylstack%U = ylstack%L + ceiling(istsz * kind(pstack) / nproma / 8.) * 8
+
276  ylstack%U = ylstack%L + floor(istsz * kind(pstack) / nproma / 8.) * 8
277 #else
278  ylstack%L = loc(pstack(1, ibl))
279  ylstack%U = ylstack%L + istsz * kind(pstack)
diff --git a/doxygen/html/main__shallow_8F90_source.html b/doxygen/html/main__shallow_8F90_source.html index 344f911c..579c123f 100644 --- a/doxygen/html/main__shallow_8F90_source.html +++ b/doxygen/html/main__shallow_8F90_source.html @@ -348,7 +348,7 @@
276 #if defined(USE_COLCALL) && defined(_OPENACC)
277  !Due to the collapse (2) directive, each point must have its own stack
278  ylstack%L = loc(pstack(1, ibl)) + ceiling(istsz * kind(pstack) / nproma / 8.) * 8 * (jlon - 1)
-
279  ylstack%U = ylstack%L + ceiling(istsz * kind(pstack) / nproma / 8.) * 8
+
279  ylstack%U = ylstack%L + floor(istsz * kind(pstack) / nproma / 8.) * 8
280 #else
281  ylstack%L = loc(pstack(1, ibl))
282  ylstack%U = ylstack%L + istsz * kind(pstack)
diff --git a/doxygen/html/main__turb_8F90_source.html b/doxygen/html/main__turb_8F90_source.html index 48d5a5c0..92d813f5 100644 --- a/doxygen/html/main__turb_8F90_source.html +++ b/doxygen/html/main__turb_8F90_source.html @@ -367,7 +367,7 @@
295 #if defined(USE_COLCALL) && defined(_OPENACC)
296  !Due to the collapse (2) directive, each point must have its own stack
297  ylstack%L = loc(pstack(1, ibl)) + ceiling(istsz * kind(pstack) / nproma / 8.) * 8 * (jlon - 1)
-
298  ylstack%U = ylstack%L + ceiling(istsz * kind(pstack) / nproma / 8.) * 8
+
298  ylstack%U = ylstack%L + floor(istsz * kind(pstack) / nproma / 8.) * 8
299 #else
300  ylstack%L = loc(pstack(1, ibl))
301  ylstack%U = ylstack%L + istsz * kind(pstack)
diff --git a/doxygen/html/mode__ice4__sedimentation__split_8F90_source.html b/doxygen/html/mode__ice4__sedimentation__split_8F90_source.html index 402c50cd..986fc72b 100644 --- a/doxygen/html/mode__ice4__sedimentation__split_8F90_source.html +++ b/doxygen/html/mode__ice4__sedimentation__split_8F90_source.html @@ -465,377 +465,374 @@
393 !
394 !* 0.2 declaration of local variables
395 !
-
396 CHARACTER(LEN=10) :: YSPE ! String for error message
-
397 INTEGER :: JIJ, JK
-
398 LOGICAL :: GPRESENT_PFPR
-
399 REAL :: ZINVTSTEP
-
400 REAL :: ZZWLBDC, ZZRAY, ZZT, ZZWLBDA, ZZCC
-
401 REAL :: ZLBDA
-
402 REAL :: ZFSED, ZEXSED
-
403 REAL :: ZMRCHANGE
-
404 REAL, DIMENSION(D%NIJT) :: ZMAX_TSTEP ! Maximum CFL in column
-
405 REAL, DIMENSION(SIZE(ICED%XRTMIN)) :: ZRSMIN
-
406 REAL, DIMENSION(D%NIJT) :: ZREMAINT ! Remaining time until the timestep end
-
407 LOGICAL :: ZANYREMAINT
-
408 REAL, DIMENSION(D%NIJT, 0:D%NKT+1) :: ZWSED ! Sedimentation fluxes
-
409 INTEGER :: IKTB, IKTE, IKB, IKL, IIJE, IIJB
-
410 REAL(KIND=jphook) :: zhook_handle
-
411 !
-
412 ! local variables for cloud electricity
-
413 REAL :: ZEXT ! e_x coefficient of the q(D) relation
-
414 REAL :: ZNCI ! N_ci for ice crystal sedimentation
-
415 !REAL, DIMENSION(D%NIJT,0:D%NKT+1) :: ZWSEDQ ! Sedimentation fluxes for electric charges
-
416 !REAL, DIMENSION(D%NIJT,0:D%NKT+1) :: ZBEARDCOEFF ! effect of electric forces on sedimentation
-
417 !REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(0:D%NKT+1,0,OELEC)) :: &
-
418 !++cb-- est-ce que cette declaration est correcte par rapport a ce qui est fait pour zwsed ?
-
419 REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT+2,0,OELEC)) :: &
-
420  ZWSEDQ ! Sedimentation fluxes for electric charges
-
421 !REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(0:D%NKT+1,0,OSEDIM_BEARD)) :: &
-
422 REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)) :: &
-
423  ZBEARDCOEFF ! effect of electric forces on sedimentation
-
424 !REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(0:D%NKT+1,0,OSEDIM_BEARD)) :: &
-
425 REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)) :: &
-
426  ZLBDA3 ! slope parameter of the distribution
-
427 !LOGICAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(0:D%NKT+1,0,OSEDIM_BEARD)) :: GMASK
-
428 LOGICAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)) :: GMASK
-
429 REAL :: ZQCHANGE
-
430 REAL :: ZFQSED, ZEXQSED
-
431 REAL :: ZEXMIN, ZEXMAX
-
432 REAL :: ZLBX, ZLBEXX
-
433 REAL :: ZFQUPDX
-
434 REAL :: ZCXX
-
435 REAL :: ZFX
-
436 ! end - local variables for cloud electricity
-
437 !
-
438 IF (lhook) CALL dr_hook('ICE4_SEDIMENTATION_SPLIT:INTERNAL_SEDIM_SPLIT', 0, zhook_handle)
-
439 !
-
440 iktb=d%NKTB
-
441 ikte=d%NKTE
-
442 ikb=d%NKB
-
443 ikl=d%NKL
-
444 iijb=d%NIJB
-
445 iije=d%NIJE
-
446 !-------------------------------------------------------------------------------
-
447 IF (kspe<2 .OR. kspe>7) CALL print_msg(nverb_fatal,'GEN','INTERNAL_SEDIM_SPLIT','invalid species (KSPE variable)')
-
448 !
-
449 IF (PRESENT(pfpr)) THEN
-
450  gpresent_pfpr = .true.
-
451 ELSE
-
452  gpresent_pfpr = .false.
-
453 END IF
-
454 !
-
455 pinprx(:) = 0.
-
456 zinvtstep=1./ptstep
-
457 zrsmin = iced%XRTMIN * zinvtstep
-
458 zremaint(:) = 0.
-
459 zremaint(iijb:iije) = ptstep
-
460 !
-
461 zanyremaint = .true.
-
462 DO WHILE (zanyremaint)
-
463  !
-
464  ! Effect of electrical forces on sedimentation
-
465  IF (oelec .AND. osedim_beard) THEN
-
466  DO jk = iktb, ikte
-
467  DO jij = iijb, iije
-
468  IF (prxt(jij,jk)>iced%XRTMIN(kspe) .AND. zremaint(jij)>0.) THEN
-
469  gmask(jij,jk) = .true.
-
470  ELSE
-
471  gmask(jij,jk) = .false.
-
472  END IF
-
473  END DO
-
474  END DO
-
475  END IF
-
476  !
-
477  !* 1. Parameters for cloud sedimentation
+
396 INTEGER :: JIJ, JK
+
397 LOGICAL :: GPRESENT_PFPR
+
398 REAL :: ZINVTSTEP
+
399 REAL :: ZZWLBDC, ZZRAY, ZZT, ZZWLBDA, ZZCC
+
400 REAL :: ZLBDA
+
401 REAL :: ZFSED, ZEXSED
+
402 REAL :: ZMRCHANGE
+
403 REAL, DIMENSION(D%NIJT) :: ZMAX_TSTEP ! Maximum CFL in column
+
404 REAL, DIMENSION(SIZE(ICED%XRTMIN)) :: ZRSMIN
+
405 REAL, DIMENSION(D%NIJT) :: ZREMAINT ! Remaining time until the timestep end
+
406 LOGICAL :: ZANYREMAINT
+
407 REAL, DIMENSION(D%NIJT, 0:D%NKT+1) :: ZWSED ! Sedimentation fluxes
+
408 INTEGER :: IKTB, IKTE, IKB, IKL, IIJE, IIJB
+
409 REAL(KIND=jphook) :: zhook_handle
+
410 !
+
411 ! local variables for cloud electricity
+
412 REAL :: ZEXT ! e_x coefficient of the q(D) relation
+
413 REAL :: ZNCI ! N_ci for ice crystal sedimentation
+
414 !REAL, DIMENSION(D%NIJT,0:D%NKT+1) :: ZWSEDQ ! Sedimentation fluxes for electric charges
+
415 !REAL, DIMENSION(D%NIJT,0:D%NKT+1) :: ZBEARDCOEFF ! effect of electric forces on sedimentation
+
416 !REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(0:D%NKT+1,0,OELEC)) :: &
+
417 !++cb-- est-ce que cette declaration est correcte par rapport a ce qui est fait pour zwsed ?
+
418 REAL, DIMENSION(MERGE(D%NIJT,0,OELEC),MERGE(D%NKT+2,0,OELEC)) :: &
+
419  ZWSEDQ ! Sedimentation fluxes for electric charges
+
420 !REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(0:D%NKT+1,0,OSEDIM_BEARD)) :: &
+
421 REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)) :: &
+
422  ZBEARDCOEFF ! effect of electric forces on sedimentation
+
423 !REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(0:D%NKT+1,0,OSEDIM_BEARD)) :: &
+
424 REAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)) :: &
+
425  ZLBDA3 ! slope parameter of the distribution
+
426 !LOGICAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(0:D%NKT+1,0,OSEDIM_BEARD)) :: GMASK
+
427 LOGICAL, DIMENSION(MERGE(D%NIJT,0,OSEDIM_BEARD),MERGE(D%NKT,0,OSEDIM_BEARD)) :: GMASK
+
428 REAL :: ZQCHANGE
+
429 REAL :: ZFQSED, ZEXQSED
+
430 REAL :: ZEXMIN, ZEXMAX
+
431 REAL :: ZLBX, ZLBEXX
+
432 REAL :: ZFQUPDX
+
433 REAL :: ZCXX
+
434 REAL :: ZFX
+
435 ! end - local variables for cloud electricity
+
436 !
+
437 IF (lhook) CALL dr_hook('ICE4_SEDIMENTATION_SPLIT:INTERNAL_SEDIM_SPLIT', 0, zhook_handle)
+
438 !
+
439 iktb=d%NKTB
+
440 ikte=d%NKTE
+
441 ikb=d%NKB
+
442 ikl=d%NKL
+
443 iijb=d%NIJB
+
444 iije=d%NIJE
+
445 !-------------------------------------------------------------------------------
+
446 IF (kspe<2 .OR. kspe>7) CALL print_msg(nverb_fatal,'GEN','INTERNAL_SEDIM_SPLIT','invalid species (KSPE variable)')
+
447 !
+
448 IF (PRESENT(pfpr)) THEN
+
449  gpresent_pfpr = .true.
+
450 ELSE
+
451  gpresent_pfpr = .false.
+
452 END IF
+
453 !
+
454 pinprx(:) = 0.
+
455 zinvtstep=1./ptstep
+
456 zrsmin = iced%XRTMIN * zinvtstep
+
457 zremaint(:) = 0.
+
458 zremaint(iijb:iije) = ptstep
+
459 !
+
460 zanyremaint = .true.
+
461 DO WHILE (zanyremaint)
+
462  !
+
463  ! Effect of electrical forces on sedimentation
+
464  IF (oelec .AND. osedim_beard) THEN
+
465  DO jk = iktb, ikte
+
466  DO jij = iijb, iije
+
467  IF (prxt(jij,jk)>iced%XRTMIN(kspe) .AND. zremaint(jij)>0.) THEN
+
468  gmask(jij,jk) = .true.
+
469  ELSE
+
470  gmask(jij,jk) = .false.
+
471  END IF
+
472  END DO
+
473  END DO
+
474  END IF
+
475  !
+
476  !* 1. Parameters for cloud sedimentation
+
477  !
478  !
-
479  !
-
480  !* 2. compute the fluxes
+
479  !* 2. compute the fluxes
+
480  !
481  !
-
482  !
-
483  IF(kspe==2) THEN
-
484  !******* for cloud
-
485  zwsed(:,:) = 0.
-
486  IF (oelec) THEN
-
487  zwsedq(:,:) = 0.
-
488  zlbda3(:,:) = 0.
-
489  END IF
-
490  DO jk = iktb,ikte
-
491  DO jij = iijb,iije
-
492  IF(prxt(jij,jk)>iced%XRTMIN(kspe) .AND. zremaint(jij)>0.) THEN
-
493  zzwlbdc = plbc(jij,jk) * pconc3d(jij,jk) / &
-
494  &(prhodref(jij,jk) * prxt(jij,jk))
-
495  zzwlbdc = zzwlbdc**iced%XLBEXC
-
496  zzray = pray(jij,jk) / zzwlbdc
-
497  zzt = ptht(jij,jk) * (ppabst(jij,jk)/cst%XP00)**(cst%XRD/cst%XCPD)
-
498  zzwlbda = 6.6e-8*(101325./ppabst(jij,jk))*(zzt/293.15)
-
499  zzcc = iced%XCC*(1.+1.26*zzwlbda/zzray)
-
500  zwsed(jij, jk) = prhodref(jij,jk)**(-iced%XCEXVT +1 ) * &
-
501  &zzwlbdc**(-iced%XDC)*zzcc*pfsedc(jij,jk) * prxt(jij,jk)
-
502 !++cb++ nouveau : traitement de la sedimentation des charges portees par les gouttelettes
-
503 ! A TESTER
-
504  IF (oelec) THEN
-
505  zext = pqxt(jij,jk) / elecp%XFQUPDC * prhodref(jij,jk)
-
506  IF (abs(zext) .GT. elecp%XECMIN) THEN
-
507  zwsedq(jij,jk) = elecp%XFQSEDC * zext * pconc3d(jij,jk) * &
-
508  prhodref(jij,jk)**(-iced%XCEXVT) * &
-
509  zzcc * zzwlbdc**(-elecp%XEXQSEDC)
-
510  IF (osedim_beard) zlbda3(jij,jk) = zzwlbdc
-
511  ENDIF
-
512  ENDIF
-
513  ENDIF
-
514 !--cb--
-
515  ENDDO
-
516  ENDDO
-
517  IF (oelec .AND. osedim_beard) THEN
-
518  CALL elec_beard_effect(d, cst, hcloud, kspe, gmask, pt, prhodref, pthvrefzikb, &
-
519  prxt, pqxt, pefieldw, zlbda3, zbeardcoeff, iced=iced)
-
520  DO jk = iktb,ikte
-
521  DO jij = iijb,iije
-
522  zwsed(jij,jk) = zwsed(jij,jk) * zbeardcoeff(jij,jk)
-
523  zwsedq(jij,jk) = zwsedq(jij,jk) * zbeardcoeff(jij,jk)
-
524  END DO
-
525  END DO
-
526  END IF
-
527  ELSEIF(kspe==4) THEN
-
528  ! ******* for pristine ice
-
529  zwsed(:,:) = 0.
-
530  IF (oelec) THEN
-
531  zwsedq(:,:) = 0.
-
532  zlbda3(:,:) = 0.
-
533  END IF
-
534  DO jk = iktb,ikte
-
535  DO jij = iijb,iije
-
536  IF(prxt(jij, jk) .GT. max(iced%XRTMIN(4), 1.0e-7) .AND. zremaint(jij)>0.) THEN
-
537  zwsed(jij, jk) = icep%XFSEDI * prxt(jij, jk) * &
-
538  & prhodref(jij,jk)**(1.-iced%XCEXVT) * & ! McF&H
-
539  & max( 0.05e6,-0.15319e6-0.021454e6* &
-
540  & alog(prhodref(jij,jk)*prxt(jij,jk)) )**icep%XEXCSEDI
-
541  IF (oelec) THEN
-
542  ! N_ci from McF&H
-
543  znci = elecp%XFCI * prhodref(jij,jk) * prxt(jij,jk) * &
-
544  max(0.05e6,-0.15319e6-0.021454e6*alog(prhodref(jij,jk)*prxt(jij,jk)))**3.
-
545  ! compute e_i of the q - D relationship
-
546  zext = pqxt(jij,jk) / elecp%XFQUPDI * &
-
547  (prhodref(jij,jk) * prxt(jij,jk))**(-elecp%XEXFQUPDI) * &
-
548  znci**(elecp%XEXFQUPDI-1.)
-
549  IF (abs(zext) .GT. elecp%XEIMIN) THEN
-
550  zwsedq(jij,jk) = elecp%XFQSEDI * zext * prxt(jij,jk) * &
-
551  prhodref(jij,jk)**(1.-iced%XCEXVT) * &
-
552  max( 0.05e6,-0.15319e6-0.021454e6* & ! McF&H
-
553  alog(prhodref(jij,jk)*prxt(jij,jk)) )**(3.*(1-elecp%XEXQSEDI))
-
554  IF (osedim_beard) zlbda3(jij,jk) = (2.14e-3 * momg(iced%XALPHAI,iced%XNUI,1.7) * &
-
555  znci / (prhodref(jij,jk) * prxt(jij,jk)))**0.588235
-
556  ENDIF
-
557  ENDIF
-
558  ENDIF
-
559  ENDDO
-
560  ENDDO
-
561  IF (oelec .AND. osedim_beard) THEN
-
562  CALL elec_beard_effect(d, cst, hcloud, kspe, gmask, pt, prhodref, pthvrefzikb, &
-
563  prxt, pqxt, pefieldw, zlbda3, zbeardcoeff, iced=iced)
-
564  DO jk = iktb,ikte
-
565  DO jij = iijb,iije
-
566  zwsed(jij,jk) = zwsed(jij,jk) * zbeardcoeff(jij,jk)
-
567  zwsedq(jij,jk) = zwsedq(jij,jk) * zbeardcoeff(jij,jk)
-
568  END DO
-
569  END DO
-
570  END IF
-
571  ELSEIF(kspe==5) THEN
-
572  ! ******* for snow
-
573  zwsed(:,:) = 0.
-
574  IF (oelec) THEN
-
575  zwsedq(:,:) = 0.
-
576  zlbda3(:,:) = 0.
-
577  END IF
-
578 #ifdef REPRO48
-
579  !The following lines must be kept equal to the computation in the general case ("for other species" case below)
-
580  zfsed=icep%XFSEDS
-
581  zexsed=icep%XEXSEDS
-
582  DO jk = iktb,ikte
-
583  DO jij = iijb,iije
-
584  IF(prxt(jij,jk)>iced%XRTMIN(kspe) .AND. zremaint(jij)>0.) THEN
-
585  zwsed(jij, jk) = zfsed * prxt(jij, jk)**zexsed &
-
586  & * prhodref(jij, jk)**(zexsed-iced%XCEXVT)
-
587  ENDIF
-
588  ENDDO
-
589  ENDDO
-
590 #else
-
591  DO jk = iktb,ikte
-
592  DO jij = iijb,iije
-
593  IF(prxt(jij,jk)> iced%XRTMIN(kspe) .AND. zremaint(jij)>0.) THEN
-
594  IF (parami%LSNOW_T .AND. pt(jij,jk)>263.15) THEN
-
595  zlbda = max(min(iced%XLBDAS_MAX, 10**(14.554-0.0423*pt(jij,jk))),iced%XLBDAS_MIN)*iced%XTRANS_MP_GAMMAS
-
596  ELSE IF (parami%LSNOW_T) THEN
-
597  zlbda = max(min(iced%XLBDAS_MAX, 10**(6.226 -0.0106*pt(jij,jk))),iced%XLBDAS_MIN)*iced%XTRANS_MP_GAMMAS
-
598  ELSE
-
599  zlbda=max(min(iced%XLBDAS_MAX, iced%XLBS * ( prhodref(jij,jk) * prxt(jij,jk) )**iced%XLBEXS),iced%XLBDAS_MIN)
-
600  END IF
-
601  zwsed(jij, jk) = icep%XFSEDS * &
-
602  & prxt(jij,jk)* &
-
603  & prhodref(jij,jk)**(1-iced%XCEXVT) * &
-
604  & (1 + (iced%XFVELOS/zlbda)**iced%XALPHAS)** (-iced%XNUS+icep%XEXSEDS/iced%XALPHAS) * &
-
605  & zlbda ** (iced%XBS+icep%XEXSEDS)
-
606  IF (oelec .AND. zlbda > 0.) THEN
-
607  ! compute the e_x coefficient of the q - D relationship
-
608  zext = prhodref(jij,jk) * pqxt(jij,jk) / (elecp%XFQUPDS * zlbda**(iced%XCXS-elecd%XFS))
-
609  zext = sign( min(abs(zext), elecp%XESMAX), zext)
-
610  IF (abs(zext) > elecp%XESMIN) THEN
-
611  zwsedq(jij,jk) = elecp%XFQSEDS * zext * prxt(jij,jk)**elecp%XEXQSEDS &
-
612  * prhodref(jij,jk)**(elecp%XEXQSEDS-iced%XCEXVT)
-
613  IF (osedim_beard) zlbda3(jij,jk) = zlbda
-
614  ENDIF
-
615  ENDIF
-
616  ENDIF
-
617  ENDDO
-
618  ENDDO
-
619  IF (oelec .AND. osedim_beard) THEN
-
620  CALL elec_beard_effect(d, cst, hcloud, kspe, gmask, pt, prhodref, pthvrefzikb,&
-
621  prxt, pqxt, pefieldw, zlbda3, zbeardcoeff, iced=iced)
-
622  DO jk = iktb,ikte
-
623  DO jij = iijb,iije
-
624  zwsed(jij,jk) = zwsed(jij,jk) * zbeardcoeff(jij,jk)
-
625  zwsedq(jij,jk) = zwsedq(jij,jk) * zbeardcoeff(jij,jk)
-
626  END DO
-
627  END DO
-
628  END IF
-
629 #endif
-
630  ELSE
-
631  ! ******* for other species
-
632  SELECT CASE(kspe)
-
633  CASE(3)
-
634  zfsed=icep%XFSEDR
-
635  zexsed=icep%XEXSEDR
-
636  CASE(6)
-
637  zfsed=icep%XFSEDG
-
638  zexsed=icep%XEXSEDG
-
639  CASE(7)
-
640  zfsed=icep%XFSEDH
-
641  zexsed=icep%XEXSEDH
-
642  CASE DEFAULT
-
643  WRITE(yspe, '( I10 )' ) kspe
-
644  CALL print_msg(nverb_fatal, 'GEN', 'ICE4_SEDIMENTATION_SPLIT', 'no sedimentation parameter for KSPE='//trim(yspe) )
-
645  END SELECT
-
646  !
-
647  IF (oelec) THEN
-
648  SELECT CASE(kspe)
-
649  CASE(3)
-
650  zfqsed = elecp%XFQSEDR
-
651  zexqsed = elecp%XEXQSEDR
-
652  zexmin = elecp%XERMIN
-
653  zexmax = elecp%XERMAX
-
654  zlbx = iced%XLBR
-
655  zlbexx = iced%XLBEXR
-
656  zfqupdx = elecp%XFQUPDR
-
657  zcxx = elecd%XCXR
-
658  zfx = elecd%XFR
-
659  CASE(6)
-
660  zfqsed = elecp%XFQSEDG
-
661  zexqsed = elecp%XEXQSEDG
-
662  zexmin = elecp%XEGMIN
-
663  zexmax = elecp%XEGMAX
-
664  zlbx = iced%XLBG
-
665  zlbexx = iced%XLBEXG
-
666  zfqupdx = elecp%XFQUPDG
-
667  zcxx = iced%XCXG
-
668  zfx = elecd%XFG
-
669  CASE(7)
-
670  zfqsed = elecp%XFQSEDH
-
671  zexqsed = elecp%XEXQSEDH
-
672  zexmin = elecp%XEHMIN
-
673  zexmax = elecp%XEHMAX
-
674  zlbx = iced%XLBH
-
675  zlbexx = iced%XLBEXH
-
676  zfqupdx = elecp%XFQUPDH
-
677  zcxx = iced%XCXH
-
678  zfx = elecd%XFH
-
679  CASE DEFAULT
-
680  write( yspe, '( I10 )' ) kspe
-
681  call print_msg( nverb_fatal, 'GEN', 'ICE4_SEDIMENTATION_SPLIT', 'no sedimentation parameter for KSPE='//trim(yspe) )
-
682  END SELECT
-
683  END IF
-
684  !
-
685  zwsed(:,:) = 0.
-
686  IF (oelec) THEN
-
687  zwsedq(:,:) = 0.
-
688  zlbda3(:,:) = 0.
-
689  END IF
-
690  DO jk = iktb,ikte
-
691  DO jij = iijb,iije
-
692  IF(prxt(jij,jk)>iced%XRTMIN(kspe) .AND. zremaint(jij)>0.) THEN
-
693  zwsed(jij, jk) = zfsed * prxt(jij, jk)**zexsed &
-
694  & * prhodref(jij, jk)**(zexsed-iced%XCEXVT)
-
695  IF (oelec) THEN
-
696  ! need lambda_x to compute e_x
-
697  zlbda = zlbx * (prhodref(jij,jk) * max(prxt(jij,jk), iced%XRTMIN(kspe)))**zlbexx
-
698  IF (zlbda > 0.) THEN
-
699  ! compute the e_x coefficient of the q - D relationship
-
700  zext = prhodref(jij,jk) * pqxt(jij,jk) / (zfqupdx * zlbda**(zcxx-zfx))
-
701  zext = sign( min(abs(zext), zexmax), zext)
-
702  END IF
-
703  IF (abs(zext) > zexmin) THEN
-
704  zwsedq(jij,jk) = zfqsed * zext * prxt(jij,jk)**zexqsed &
-
705  * prhodref(jij,jk)**(zexqsed-iced%XCEXVT)
-
706  IF (osedim_beard) zlbda3(jij,jk) = zlbda
-
707  END IF
-
708  ENDIF
-
709  ENDIF
-
710  ENDDO
-
711  ENDDO
-
712  IF (oelec .AND. osedim_beard) THEN
-
713  CALL elec_beard_effect(d, cst, hcloud, kspe, gmask, pt, prhodref, pthvrefzikb, &
-
714  prxt, pqxt, pefieldw, zlbda3, zbeardcoeff, iced=iced)
-
715  DO jk = iktb,ikte
-
716  DO jij = iijb,iije
-
717  zwsed(jij,jk) = zwsed(jij,jk) * zbeardcoeff(jij,jk)
-
718  zwsedq(jij,jk) = zwsedq(jij,jk) * zbeardcoeff(jij,jk)
-
719  END DO
-
720  END DO
-
721  END IF
-
722  ENDIF
-
723  zmax_tstep(:) = zremaint(:)
-
724  DO jk = iktb,ikte
-
725  DO jij = iijb,iije
-
726  IF(prxt(jij,jk)>iced%XRTMIN(kspe) .AND. zwsed(jij, jk)>1.e-20 .AND. zremaint(jij)>0.) THEN
-
727  zmax_tstep(jij) = min(zmax_tstep(jij), parami%XSPLIT_MAXCFL * prhodref(jij, jk) * &
-
728  & prxt(jij, jk) * pdzz(jij, jk) / zwsed(jij, jk))
-
729  ENDIF
-
730  ENDDO
-
731  ENDDO
-
732 
-
733  DO jij = iijb, iije
-
734  zremaint(jij) = zremaint(jij) - zmax_tstep(jij)
-
735  pinprx(jij) = pinprx(jij) + zwsed(jij,ikb) / cst%XRHOLW * (zmax_tstep(jij) * zinvtstep)
-
736  ENDDO
-
737 
-
738  DO jk = iktb , ikte
-
739  DO jij = iijb, iije
-
740  zmrchange = zmax_tstep(jij) * poorhodz(jij,jk)*(zwsed(jij,jk+ikl)-zwsed(jij,jk))
-
741  prxt(jij,jk) = prxt(jij,jk) + zmrchange + pprxs(jij,jk) * zmax_tstep(jij)
-
742  prxs(jij,jk) = prxs(jij,jk) + zmrchange * zinvtstep
-
743  IF (gpresent_pfpr) THEN
-
744  pfpr(jij,jk,kspe) = pfpr(jij,jk,kspe) + zwsed(jij,jk) * (zmax_tstep(jij) * zinvtstep)
-
745  ENDIF
-
746  IF (oelec) THEN
-
747  zqchange = zmax_tstep(jij) * poorhodz(jij,jk) * (zwsedq(jij,jk+ikl) - zwsedq(jij,jk))
-
748  pqxt(jij,jk) = pqxt(jij,jk) + zqchange + ppqxs(jij,jk) * zmax_tstep(jij)
-
749  pqxs(jij,jk) = pqxs(jij,jk) + zqchange * zinvtstep
-
750  ENDIF
-
751  ENDDO
-
752  ENDDO
-
753  !
-
754  zanyremaint = .false.
-
755  DO jij=iijb,iije
-
756  IF(zremaint(jij)>0.) THEN
-
757  zanyremaint = .true.
-
758  END IF
-
759  END DO
-
760 END DO
+
482  IF(kspe==2) THEN
+
483  !******* for cloud
+
484  zwsed(:,:) = 0.
+
485  IF (oelec) THEN
+
486  zwsedq(:,:) = 0.
+
487  zlbda3(:,:) = 0.
+
488  END IF
+
489  DO jk = iktb,ikte
+
490  DO jij = iijb,iije
+
491  IF(prxt(jij,jk)>iced%XRTMIN(kspe) .AND. zremaint(jij)>0.) THEN
+
492  zzwlbdc = plbc(jij,jk) * pconc3d(jij,jk) / &
+
493  &(prhodref(jij,jk) * prxt(jij,jk))
+
494  zzwlbdc = zzwlbdc**iced%XLBEXC
+
495  zzray = pray(jij,jk) / zzwlbdc
+
496  zzt = ptht(jij,jk) * (ppabst(jij,jk)/cst%XP00)**(cst%XRD/cst%XCPD)
+
497  zzwlbda = 6.6e-8*(101325./ppabst(jij,jk))*(zzt/293.15)
+
498  zzcc = iced%XCC*(1.+1.26*zzwlbda/zzray)
+
499  zwsed(jij, jk) = prhodref(jij,jk)**(-iced%XCEXVT +1 ) * &
+
500  &zzwlbdc**(-iced%XDC)*zzcc*pfsedc(jij,jk) * prxt(jij,jk)
+
501 !++cb++ nouveau : traitement de la sedimentation des charges portees par les gouttelettes
+
502 ! A TESTER
+
503  IF (oelec) THEN
+
504  zext = pqxt(jij,jk) / elecp%XFQUPDC * prhodref(jij,jk)
+
505  IF (abs(zext) .GT. elecp%XECMIN) THEN
+
506  zwsedq(jij,jk) = elecp%XFQSEDC * zext * pconc3d(jij,jk) * &
+
507  prhodref(jij,jk)**(-iced%XCEXVT) * &
+
508  zzcc * zzwlbdc**(-elecp%XEXQSEDC)
+
509  IF (osedim_beard) zlbda3(jij,jk) = zzwlbdc
+
510  ENDIF
+
511  ENDIF
+
512  ENDIF
+
513 !--cb--
+
514  ENDDO
+
515  ENDDO
+
516  IF (oelec .AND. osedim_beard) THEN
+
517  CALL elec_beard_effect(d, cst, hcloud, kspe, gmask, pt, prhodref, pthvrefzikb, &
+
518  prxt, pqxt, pefieldw, zlbda3, zbeardcoeff, iced=iced)
+
519  DO jk = iktb,ikte
+
520  DO jij = iijb,iije
+
521  zwsed(jij,jk) = zwsed(jij,jk) * zbeardcoeff(jij,jk)
+
522  zwsedq(jij,jk) = zwsedq(jij,jk) * zbeardcoeff(jij,jk)
+
523  END DO
+
524  END DO
+
525  END IF
+
526  ELSEIF(kspe==4) THEN
+
527  ! ******* for pristine ice
+
528  zwsed(:,:) = 0.
+
529  IF (oelec) THEN
+
530  zwsedq(:,:) = 0.
+
531  zlbda3(:,:) = 0.
+
532  END IF
+
533  DO jk = iktb,ikte
+
534  DO jij = iijb,iije
+
535  IF(prxt(jij, jk) .GT. max(iced%XRTMIN(4), 1.0e-7) .AND. zremaint(jij)>0.) THEN
+
536  zwsed(jij, jk) = icep%XFSEDI * prxt(jij, jk) * &
+
537  & prhodref(jij,jk)**(1.-iced%XCEXVT) * & ! McF&H
+
538  & max( 0.05e6,-0.15319e6-0.021454e6* &
+
539  & alog(prhodref(jij,jk)*prxt(jij,jk)) )**icep%XEXCSEDI
+
540  IF (oelec) THEN
+
541  ! N_ci from McF&H
+
542  znci = elecp%XFCI * prhodref(jij,jk) * prxt(jij,jk) * &
+
543  max(0.05e6,-0.15319e6-0.021454e6*alog(prhodref(jij,jk)*prxt(jij,jk)))**3.
+
544  ! compute e_i of the q - D relationship
+
545  zext = pqxt(jij,jk) / elecp%XFQUPDI * &
+
546  (prhodref(jij,jk) * prxt(jij,jk))**(-elecp%XEXFQUPDI) * &
+
547  znci**(elecp%XEXFQUPDI-1.)
+
548  IF (abs(zext) .GT. elecp%XEIMIN) THEN
+
549  zwsedq(jij,jk) = elecp%XFQSEDI * zext * prxt(jij,jk) * &
+
550  prhodref(jij,jk)**(1.-iced%XCEXVT) * &
+
551  max( 0.05e6,-0.15319e6-0.021454e6* & ! McF&H
+
552  alog(prhodref(jij,jk)*prxt(jij,jk)) )**(3.*(1-elecp%XEXQSEDI))
+
553  IF (osedim_beard) zlbda3(jij,jk) = (2.14e-3 * momg(iced%XALPHAI,iced%XNUI,1.7) * &
+
554  znci / (prhodref(jij,jk) * prxt(jij,jk)))**0.588235
+
555  ENDIF
+
556  ENDIF
+
557  ENDIF
+
558  ENDDO
+
559  ENDDO
+
560  IF (oelec .AND. osedim_beard) THEN
+
561  CALL elec_beard_effect(d, cst, hcloud, kspe, gmask, pt, prhodref, pthvrefzikb, &
+
562  prxt, pqxt, pefieldw, zlbda3, zbeardcoeff, iced=iced)
+
563  DO jk = iktb,ikte
+
564  DO jij = iijb,iije
+
565  zwsed(jij,jk) = zwsed(jij,jk) * zbeardcoeff(jij,jk)
+
566  zwsedq(jij,jk) = zwsedq(jij,jk) * zbeardcoeff(jij,jk)
+
567  END DO
+
568  END DO
+
569  END IF
+
570  ELSEIF(kspe==5) THEN
+
571  ! ******* for snow
+
572  zwsed(:,:) = 0.
+
573  IF (oelec) THEN
+
574  zwsedq(:,:) = 0.
+
575  zlbda3(:,:) = 0.
+
576  END IF
+
577 #ifdef REPRO48
+
578  !The following lines must be kept equal to the computation in the general case ("for other species" case below)
+
579  zfsed=icep%XFSEDS
+
580  zexsed=icep%XEXSEDS
+
581  DO jk = iktb,ikte
+
582  DO jij = iijb,iije
+
583  IF(prxt(jij,jk)>iced%XRTMIN(kspe) .AND. zremaint(jij)>0.) THEN
+
584  zwsed(jij, jk) = zfsed * prxt(jij, jk)**zexsed &
+
585  & * prhodref(jij, jk)**(zexsed-iced%XCEXVT)
+
586  ENDIF
+
587  ENDDO
+
588  ENDDO
+
589 #else
+
590  DO jk = iktb,ikte
+
591  DO jij = iijb,iije
+
592  IF(prxt(jij,jk)> iced%XRTMIN(kspe) .AND. zremaint(jij)>0.) THEN
+
593  IF (parami%LSNOW_T .AND. pt(jij,jk)>263.15) THEN
+
594  zlbda = max(min(iced%XLBDAS_MAX, 10**(14.554-0.0423*pt(jij,jk))),iced%XLBDAS_MIN)*iced%XTRANS_MP_GAMMAS
+
595  ELSE IF (parami%LSNOW_T) THEN
+
596  zlbda = max(min(iced%XLBDAS_MAX, 10**(6.226 -0.0106*pt(jij,jk))),iced%XLBDAS_MIN)*iced%XTRANS_MP_GAMMAS
+
597  ELSE
+
598  zlbda=max(min(iced%XLBDAS_MAX, iced%XLBS * ( prhodref(jij,jk) * prxt(jij,jk) )**iced%XLBEXS),iced%XLBDAS_MIN)
+
599  END IF
+
600  zwsed(jij, jk) = icep%XFSEDS * &
+
601  & prxt(jij,jk)* &
+
602  & prhodref(jij,jk)**(1-iced%XCEXVT) * &
+
603  & (1 + (iced%XFVELOS/zlbda)**iced%XALPHAS)** (-iced%XNUS+icep%XEXSEDS/iced%XALPHAS) * &
+
604  & zlbda ** (iced%XBS+icep%XEXSEDS)
+
605  IF (oelec .AND. zlbda > 0.) THEN
+
606  ! compute the e_x coefficient of the q - D relationship
+
607  zext = prhodref(jij,jk) * pqxt(jij,jk) / (elecp%XFQUPDS * zlbda**(iced%XCXS-elecd%XFS))
+
608  zext = sign( min(abs(zext), elecp%XESMAX), zext)
+
609  IF (abs(zext) > elecp%XESMIN) THEN
+
610  zwsedq(jij,jk) = elecp%XFQSEDS * zext * prxt(jij,jk)**elecp%XEXQSEDS &
+
611  * prhodref(jij,jk)**(elecp%XEXQSEDS-iced%XCEXVT)
+
612  IF (osedim_beard) zlbda3(jij,jk) = zlbda
+
613  ENDIF
+
614  ENDIF
+
615  ENDIF
+
616  ENDDO
+
617  ENDDO
+
618  IF (oelec .AND. osedim_beard) THEN
+
619  CALL elec_beard_effect(d, cst, hcloud, kspe, gmask, pt, prhodref, pthvrefzikb,&
+
620  prxt, pqxt, pefieldw, zlbda3, zbeardcoeff, iced=iced)
+
621  DO jk = iktb,ikte
+
622  DO jij = iijb,iije
+
623  zwsed(jij,jk) = zwsed(jij,jk) * zbeardcoeff(jij,jk)
+
624  zwsedq(jij,jk) = zwsedq(jij,jk) * zbeardcoeff(jij,jk)
+
625  END DO
+
626  END DO
+
627  END IF
+
628 #endif
+
629  ELSE
+
630  ! ******* for other species
+
631  SELECT CASE(kspe)
+
632  CASE(3)
+
633  zfsed=icep%XFSEDR
+
634  zexsed=icep%XEXSEDR
+
635  CASE(6)
+
636  zfsed=icep%XFSEDG
+
637  zexsed=icep%XEXSEDG
+
638  CASE(7)
+
639  zfsed=icep%XFSEDH
+
640  zexsed=icep%XEXSEDH
+
641  CASE DEFAULT
+
642  CALL print_msg(nverb_fatal, 'GEN', 'ICE4_SEDIMENTATION_SPLIT', 'no sedimentation parameter for KSPE')
+
643  END SELECT
+
644  !
+
645  IF (oelec) THEN
+
646  SELECT CASE(kspe)
+
647  CASE(3)
+
648  zfqsed = elecp%XFQSEDR
+
649  zexqsed = elecp%XEXQSEDR
+
650  zexmin = elecp%XERMIN
+
651  zexmax = elecp%XERMAX
+
652  zlbx = iced%XLBR
+
653  zlbexx = iced%XLBEXR
+
654  zfqupdx = elecp%XFQUPDR
+
655  zcxx = elecd%XCXR
+
656  zfx = elecd%XFR
+
657  CASE(6)
+
658  zfqsed = elecp%XFQSEDG
+
659  zexqsed = elecp%XEXQSEDG
+
660  zexmin = elecp%XEGMIN
+
661  zexmax = elecp%XEGMAX
+
662  zlbx = iced%XLBG
+
663  zlbexx = iced%XLBEXG
+
664  zfqupdx = elecp%XFQUPDG
+
665  zcxx = iced%XCXG
+
666  zfx = elecd%XFG
+
667  CASE(7)
+
668  zfqsed = elecp%XFQSEDH
+
669  zexqsed = elecp%XEXQSEDH
+
670  zexmin = elecp%XEHMIN
+
671  zexmax = elecp%XEHMAX
+
672  zlbx = iced%XLBH
+
673  zlbexx = iced%XLBEXH
+
674  zfqupdx = elecp%XFQUPDH
+
675  zcxx = iced%XCXH
+
676  zfx = elecd%XFH
+
677  CASE DEFAULT
+
678  CALL print_msg( nverb_fatal, 'GEN', 'ICE4_SEDIMENTATION_SPLIT', 'no sedimentation parameter for KSPE')
+
679  END SELECT
+
680  END IF
+
681  !
+
682  zwsed(:,:) = 0.
+
683  IF (oelec) THEN
+
684  zwsedq(:,:) = 0.
+
685  zlbda3(:,:) = 0.
+
686  END IF
+
687  DO jk = iktb,ikte
+
688  DO jij = iijb,iije
+
689  IF(prxt(jij,jk)>iced%XRTMIN(kspe) .AND. zremaint(jij)>0.) THEN
+
690  zwsed(jij, jk) = zfsed * prxt(jij, jk)**zexsed &
+
691  & * prhodref(jij, jk)**(zexsed-iced%XCEXVT)
+
692  IF (oelec) THEN
+
693  ! need lambda_x to compute e_x
+
694  zlbda = zlbx * (prhodref(jij,jk) * max(prxt(jij,jk), iced%XRTMIN(kspe)))**zlbexx
+
695  IF (zlbda > 0.) THEN
+
696  ! compute the e_x coefficient of the q - D relationship
+
697  zext = prhodref(jij,jk) * pqxt(jij,jk) / (zfqupdx * zlbda**(zcxx-zfx))
+
698  zext = sign( min(abs(zext), zexmax), zext)
+
699  END IF
+
700  IF (abs(zext) > zexmin) THEN
+
701  zwsedq(jij,jk) = zfqsed * zext * prxt(jij,jk)**zexqsed &
+
702  * prhodref(jij,jk)**(zexqsed-iced%XCEXVT)
+
703  IF (osedim_beard) zlbda3(jij,jk) = zlbda
+
704  END IF
+
705  ENDIF
+
706  ENDIF
+
707  ENDDO
+
708  ENDDO
+
709  IF (oelec .AND. osedim_beard) THEN
+
710  CALL elec_beard_effect(d, cst, hcloud, kspe, gmask, pt, prhodref, pthvrefzikb, &
+
711  prxt, pqxt, pefieldw, zlbda3, zbeardcoeff, iced=iced)
+
712  DO jk = iktb,ikte
+
713  DO jij = iijb,iije
+
714  zwsed(jij,jk) = zwsed(jij,jk) * zbeardcoeff(jij,jk)
+
715  zwsedq(jij,jk) = zwsedq(jij,jk) * zbeardcoeff(jij,jk)
+
716  END DO
+
717  END DO
+
718  END IF
+
719  ENDIF
+
720  zmax_tstep(:) = zremaint(:)
+
721  DO jk = iktb,ikte
+
722  DO jij = iijb,iije
+
723  IF(prxt(jij,jk)>iced%XRTMIN(kspe) .AND. zwsed(jij, jk)>1.e-20 .AND. zremaint(jij)>0.) THEN
+
724  zmax_tstep(jij) = min(zmax_tstep(jij), parami%XSPLIT_MAXCFL * prhodref(jij, jk) * &
+
725  & prxt(jij, jk) * pdzz(jij, jk) / zwsed(jij, jk))
+
726  ENDIF
+
727  ENDDO
+
728  ENDDO
+
729 
+
730  DO jij = iijb, iije
+
731  zremaint(jij) = zremaint(jij) - zmax_tstep(jij)
+
732  pinprx(jij) = pinprx(jij) + zwsed(jij,ikb) / cst%XRHOLW * (zmax_tstep(jij) * zinvtstep)
+
733  ENDDO
+
734 
+
735  DO jk = iktb , ikte
+
736  DO jij = iijb, iije
+
737  zmrchange = zmax_tstep(jij) * poorhodz(jij,jk)*(zwsed(jij,jk+ikl)-zwsed(jij,jk))
+
738  prxt(jij,jk) = prxt(jij,jk) + zmrchange + pprxs(jij,jk) * zmax_tstep(jij)
+
739  prxs(jij,jk) = prxs(jij,jk) + zmrchange * zinvtstep
+
740  IF (gpresent_pfpr) THEN
+
741  pfpr(jij,jk,kspe) = pfpr(jij,jk,kspe) + zwsed(jij,jk) * (zmax_tstep(jij) * zinvtstep)
+
742  ENDIF
+
743  IF (oelec) THEN
+
744  zqchange = zmax_tstep(jij) * poorhodz(jij,jk) * (zwsedq(jij,jk+ikl) - zwsedq(jij,jk))
+
745  pqxt(jij,jk) = pqxt(jij,jk) + zqchange + ppqxs(jij,jk) * zmax_tstep(jij)
+
746  pqxs(jij,jk) = pqxs(jij,jk) + zqchange * zinvtstep
+
747  ENDIF
+
748  ENDDO
+
749  ENDDO
+
750  !
+
751  zanyremaint = .false.
+
752  DO jij=iijb,iije
+
753  IF(zremaint(jij)>0.) THEN
+
754  zanyremaint = .true.
+
755  END IF
+
756  END DO
+
757 END DO
+
758 !
+
759 IF (lhook) CALL dr_hook('ICE4_SEDIMENTATION_SPLIT:INTERNAL_SEDIM_SPLIT', 1, zhook_handle)
+
760 END SUBROUTINE internal_sedim_spli
761 !
-
762 IF (lhook) CALL dr_hook('ICE4_SEDIMENTATION_SPLIT:INTERNAL_SEDIM_SPLIT', 1, zhook_handle)
-
763 END SUBROUTINE internal_sedim_spli
-
764 !
-
765 END SUBROUTINE ice4_sedimentation_split
-
766 END MODULE mode_ice4_sedimentation_split
+
762 END SUBROUTINE ice4_sedimentation_split
+
763 END MODULE mode_ice4_sedimentation_split
mode_msg::print_msg
Definition: mode_msg.F90:18
modi_gamma::gamma
Definition: modi_gamma.F90:10
modi_momg::momg
Definition: momg.F90:9