Changeset 4776


Ignore:
Timestamp:
Dec 15, 2023, 5:48:36 PM (5 months ago)
Author:
cagosta
Message:

converge phylmdiso/cv3_routine to phylmd for debug

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmdiso/cv3_routines.F90

    r4613 r4776  
    379379      integer ixt 
    380380#endif
    381 
    382381!jyg20140217<
    383382  INTEGER iostat
    … …  
    411410       enddo !do i=1,len
    412411#endif
    413 
    414412  IF (first) THEN
    415413!$OMP MASTER
    … …  
    561559#endif
    562560#endif
    563 
    564561!jyg20140217<
    565562    IF (ok_new_feed) THEN
    … …  
    975972#endif
    976973#endif
    977 
    978 
    979974! ori      do 380 k=minorig,icbsmax2
    980975! ori       do 370 i=1,len
    … …  
    10761071
    10771072  END DO
    1078 
    10791073
    10801074#ifdef ISO
    … …  
    11471141#endif 
    11481142#endif
    1149 
    11501143  RETURN
    11511144END SUBROUTINE cv3_undilute1
    … …  
    14251418#endif
    14261419#endif
    1427 
    1428 
    14291420  RETURN
    14301421END SUBROUTINE cv3_compress
    … …  
    15841575  REAL                                               :: coefx, coefm, Zx, Zm, Ux, U, Um
    15851576
    1586 
    15871577#ifdef ISO
    15881578      integer ixt
    … …  
    15901580      real clw_k(nloc),tg_k(nloc),xt_k(ntraciso,nloc)
    15911581#endif
    1592 
    15931582  IF (prt_level >= 10) THEN
    15941583    print *,'cv3_undilute2.0. icvflag_Tpa, t(1,k), q(1,k), qs(1,k) ', &
    … …  
    16861675  enddo
    16871676#endif
    1688 
    16891677!jyg<
    16901678! =====================================================================
    … …  
    18221810        CALL abort_gcm('cv3_routines 1813','isos pas prevus ici',1)
    18231811#endif
    1824 
    18251812    DO k = minorig + 1, nl
    18261813      DO i = 1,ncum
    … …  
    21032090!>jyg
    21042091    END DO
    2105 
    21062092#ifdef ISO
    21072093       ! calcul de zfice
    … …  
    21712157#endif       
    21722158#endif
    2173 
    2174 
    21752159  END DO
    21762160
    … …  
    21782162!
    21792163  ENDIF ! (icvflag_Tpa == 2) ELSEIF (icvflag_Tpa == 1) ELSE (icvflag_Tpa == 0)
    2180 
    2181 
    21822164#ifdef ISOVERIF
    21832165  DO k = 1, nl
    … …  
    29932975        END IF ! new
    29942976      END DO
    2995 
    29962977#ifdef ISO
    29972978       do il=1,ncum
    … …  
    31503131!        write(*,*) 'cv3_routine tmp 1984: cond=',elij(il,i,j)               
    31513132#endif
    3152 
    3153 
    3154 
    31553133    END DO
    31563134
    … …  
    32353213
    32363214#endif
    3237 
    32383215      END IF
    32393216    END DO
    … …  
    34693446        endif !if (option_tmin.ge.1) then
    34703447#endif
    3471 
    34723448      END IF
    34733449    END DO ! il
    … …  
    35113487    END DO
    35123488  END DO
    3513 
    3514 
    35153489
    35163490#ifdef ISO
    … …  
    35953569        endif !if (option_tmin.eq.1) then
    35963570#endif
    3597 #endif 
    3598 
    3599 
     3571#endif
    36003572  RETURN
    36013573END SUBROUTINE cv3_mixing
    … …  
    36713643#endif
    36723644
    3673 
    36743645!input/output
    36753646  INTEGER, DIMENSION (nloc), INTENT (INOUT)          :: iflag(nloc)
    … …  
    36933664  REAL, DIMENSION (ntraciso,nloc, na), INTENT (OUT)           :: xtwdtrainA
    36943665#endif
    3695 
    36963666
    36973667!local variables
    … …  
    37743744        enddo !do i=1,nd
    37753745#endif
    3776 
    37773746
    37783747! ***  Set the fractionnal area sigd of precipitating downdraughts
    … …  
    38283797        enddo
    38293798#endif
    3830 
    38313799    END DO
    38323800  END DO
    … …  
    40153983      CALL abort_gcm('cv3_routines 4037','isos pas prevus ici',1)
    40163984#endif
    4017 
    40183985!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    40193986      IF (adiab_ascent_mass_flux_depends_on_ejectliq) THEN
    … …  
    41624129        CALL abort_physic('cv3_routines 3644', 'isotopes pas prevus ici, coder la glace', 1)
    41634130#endif
    4164 
    41654131!   b6=bfac*50.*sigd(il)*(ph(il,i)-ph(il,i+1))*sigt*afac
    41664132!   c6=prec(il,i+1)+bfac*wdtrain(il) &
    … …  
    44594425        IF (mplus(il)) THEN
    44604426
    4461 !         IF (mp(il,i).gt.1.0E-16) THEN ! C Risi: ajout de la condition?
    4462 
     4427!         IF (mp(il,i).gt.1.0E-16) THEN ! C Risi: ajout de la condition?
    44634428          IF (cvflag_grav) THEN
    44644429            rp(il, i) = rp(il, i+1)*mp(il, i+1) + rr(il, i)*(mp(il,i)-mp(il,i+1)) + &
    … …  
    45214486!AC!       enddo
    45224487!AC!      end do
    4523 
    45244488
    45254489#ifdef ISO
    … …  
    46614625#endif
    46624626400 END DO
    4663 
    4664 
    46654627#ifdef ISO   
    46664628!      write(*,*) 'nl=',nl,'nd=',nd,'; ncum=',ncum 
    … …  
    46984660#endif
    46994661#endif
    4700 
    47014662! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    47024663
    … …  
    47384699    USE print_control_mod, ONLY: lunout, prt_level
    47394700    USE add_phys_tend_mod, only : fl_cor_ebil
    4740 
    47414701
    47424702#ifdef ISO
    … …  
    48534813      REAL, DIMENSION (nloc)                             :: esum, fsum, gsum, hsum
    48544814      REAL, DIMENSION (nloc, nd)                         :: th_wake
    4855       REAL, DIMENSION (nloc, nd, nd)                     :: qdet
    48564815      REAL, DIMENSION (nloc)                             :: alpha_qpos, alpha_qpos1
    48574816      REAL, DIMENSION (nloc, nd)                         :: qcond, nqcond, wa           ! cld
    … …  
    48594818      REAL, DIMENSION (nloc)                             :: sument
    48604819      REAL, DIMENSION (nloc, nd)                         :: sigment, qtment             ! cld
     4820      REAL, DIMENSION (nloc, nd, nd)                     :: qdet
    48614821      REAL sumdq !jyg
    4862 
    48634822#ifdef ISO
    48644823      integer ixt
    … …  
    49044863#endif
    49054864#endif
    4906 
    49074865!
    49084866! -------------------------------------------------------------
    … …  
    50114969        precip(il) = wt(il, 1)*sigd(il)*(water(il,1)+ice(il,1)) &
    50124970                              *86400.*1000./(rowl*grav)
    5013 
    50144971#ifdef ISO
    50154972         do ixt = 1, ntraciso
    … …  
    50485005          ! end cam verif
    50495006#endif
    5050 
    50515007      ELSE
    50525008        precip(il) = wt(il, 1)*sigd(il)*water(il, 1) &
    … …  
    53645320        fr(il, 1) = fr(il, 1) + 0.01*grav*work(il)*ment(il, j, 1)*(qent(il,j,1)-rr(il,1))
    53655321        fr_comp(il,1) = fr_comp(il,1) + 0.01*grav*work(il)*ment(il, j, 1)*(qent(il,j,1)-rr(il,1))
    5366 
    53675322#ifdef ISO
    53685323       do ixt = 1, ntraciso
    … …  
    55855540    DO il = 1, ncum
    55865541      IF (j<=inb(il)) THEN
    5587         dn_to(il,i) = dn_to(il,i) + ment(il,j,i)
     5542!!        dn_to(il,i) = dn_to(il,i) + ment(il,j,i)       !jyg,20220202
     5543        dn_to(il,i) = dn_to(il,i) - ment(il,j,i)
    55885544      ENDIF
    55895545    ENDDO
    … …  
    55955551    DO il = 1, ncum
    55965552      IF (i<=inb(il)) THEN
    5597         dn_from(il,i) = dn_from(il,i) + ment(il,i,j)
     5553!!        dn_from(il,i) = dn_from(il,i) + ment(il,i,j)   !jyg,20220202
     5554        dn_from(il,i) = dn_from(il,i) - ment(il,i,j)
    55985555      ENDIF
    55995556    ENDDO
    … …  
    56075564DO i = nl-1, 1, -1
    56085565  DO il = 1, ncum
    5609     dnwd(il,i) = max(0., dnwd(il,i+1) - dn_to(il,i) + dn_from(il,i))
     5566!!    dnwd(il,i) = max(0., dnwd(il,i+1) - dn_to(il,i) + dn_from(il,i)) !jyg,20220202
     5567    dnwd(il,i) = min(0., dnwd(il,i+1) - dn_to(il,i) + dn_from(il,i))
    56105568  ENDDO
    56115569ENDDO
    … …  
    56335591      IF (i<=inb(il) .AND. iflag(il)<=1) num1 = num1 + 1
    56345592    END DO
    5635         qdet(il,i,i) = qent(il,i,i)                                            ! cld Louis : specific humidity in detraining water
    56365593    IF (num1<=0) GO TO 500
    56375594
    … …  
    60846041#endif
    60856042
    6086 
    60876043        fu(il, i) = 0.01*grav*(mp(il,i+1)*(up(il,i+1)-u(il,i)) - &
    60886044                               mp(il,i)*(up(il,i)-u(il,i-1)))*dpinv
    … …  
    60936049        fr(il, i) = fr(il, i) + 0.01*grav*dpinv*(amp1(il)*(rr(il,i+1)-rr(il,i)) - &
    60946050                                                 ad(il)*(rr(il,i)-rr(il,i-1)))
    6095 
    60966051#ifdef ISO
    60976052       do ixt = 1, ntraciso
    … …  
    61586113       ! end cam verif
    61596114#endif
    6160 
    61616115        fu(il, i) = fu(il, i) + 0.01*grav*dpinv*(amp1(il)*(u(il,i+1)-u(il,i)) - &
    61626116                                                 ad(il)*(u(il,i)-u(il,i-1)))
    … …  
    62386192       ! end cam verif
    62396193#endif
    6240 
    62416194!
    62426195          END IF ! i
    … …  
    62516204                                                       (qent(il,k,i)-awat(il)-rr(il,i))
    62526205          fr_comp(il,i) = fr_comp(il,i) + 0.01*grav*dpinv*ment(il, k, i)*(qent(il,k,i)-awat(il)-rr(il,i))
    6253 
    62546206#ifdef ISO
    62556207      do ixt = 1, ntraciso
    … …  
    63156267#endif
    63166268#endif
    6317 
    63186269          fu(il, i) = fu(il, i) + 0.01*grav*dpinv*ment(il, k, i)*(uent(il,k,i)-u(il,i))
    63196270          fv(il, i) = fv(il, i) + 0.01*grav*dpinv*ment(il, k, i)*(vent(il,k,i)-v(il,i))
    … …  
    64886439!      PROBLEM: Should not qent(il,i,i) be taken into account even if nent(il,i)/=0?
    64896440!!        qtment(il, i) = qent(il,k,i) + qtment(il,i)                            ! cld
     6441        qdet(il,i,i) = qent(il,i,i)                                            ! cld Louis : specific humidity in detraining water
    64906442        qtment(il, i) = qent(il,i,i) + qtment(il,i)                            ! cld
    64916443!>jyg
    … …  
    65626514                                                 (ph(il,inb(il)-1)-ph(il,inb(il)))
    65636515
    6564 
    6565 #ifdef ISO 
     6516#ifdef ISO
    65666517        do ixt=1,ntraciso
    65676518          xtbx(ixt)=0.01*grav*ment(il,inb(il),inb(il)) &
    … …  
    66276578#endif       
    66286579#endif
    6629 
    66306580      cx = 0.01*grav*ment(il, inb(il), inb(il))*(uent(il,inb(il),inb(il))-u(il,inb(il)))/ &
    66316581                                                 (ph(il,inb(il))-ph(il,inb(il)+1))
    … …  
    68246774#endif         
    68256775#endif
    6826 
    68276776        END IF
    68286777      END DO
    … …  
    69476896#endif       
    69486897#endif
    6949 
    69506898      END IF
    69516899    END DO
    … …  
    73107258    END DO                                                           ! cld
    73117259  END DO
    7312 
    73137260#ifdef ISO
    73147261#ifdef DIAGISO
    … …  
    74777424#endif
    74787425#endif
    7479 
    74807426  IMPLICIT NONE
    74817427
    … …  
    76467592#endif
    76477593#endif
    7648 
    76497594!AC!        do 2100 j=1,ntra
    76507595!AC!c oct3         do 2110 k=1,nl
Note: See TracChangeset for help on using the changeset viewer.