Changeset 2765 for LMDZ5/trunk


Ignore:
Timestamp:
Jan 19, 2017, 3:15:40 PM (8 years ago)
Author:
fhourdin
Message:

Inclusion d'un traitement spécifique dans l'advection verticale
pour les cas de nombre de courant w/masse > 1
ou w est le transfert de masse entre deux couches.

ce traitement garanti la convergence numérique quand le critère
n'est jamais violé.
Dans les autres cas, il fait proprement le transport vertical
qui est autrement hors de contrôle.
Pourrait contribuer a resoudre les plantages himalayens.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • LMDZ5/trunk/libf/dyn3dmem/vlsplt_loc.F

    r2603 r2765  
    885885c
    886886      INTEGER i,ij,l,j,ii
     887
     888      REAL,DIMENSION(ijb_u:ije_u,llm+1) :: wresi,morig,qorig,dzqorig
     889      INTEGER,DIMENSION(ijb_u:ije_u,llm+1) :: lorig
     890      INTEGER,SAVE :: countcfl
     891!$OMP THREADPRIVATE(countcfl)
    887892c
    888893      REAL newmasse
     
    911916      ! vlz_loc si on veut qu'elles soient vues par tous les threads. 
    912917      INTEGER ifils,iq2 ! CRisi
     918
    913919
    914920      IF (first) THEN
     
    968974      ENDIF
    969975#endif
     976
     977!--------------------------------------------------------
     978! On repere les points qui violent le CFL (|w| > masse)
     979!--------------------------------------------------------
     980
     981      countcfl=0
     982!     print*,'vlz nouveau'
     983c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     984      DO l = 2,llm
     985         DO ij = ijb,ije
     986          IF(  (w(ij,l,iq)>0.AND.w(ij,l,iq)>masse(ij,l,iq))
     987     s    .OR. (w(ij,l,iq)<=0.AND.ABS(w(ij,l,iq))>masse(ij,l-1,iq)) )
     988     s    countcfl=countcfl+1
     989         ENDDO
     990      ENDDO
     991c$OMP END DO NOWAIT   
     992
     993c ---------------------------------------------------------------
     994c  Identification des mailles ou on viole le CFL : w > masse
     995c ---------------------------------------------------------------
     996
     997      IF (countcfl==0) THEN
     998
    970999c ---------------------------------------------------------------
    9711000c   .... calcul des termes d'advection verticale  .......
     1001c     Dans le cas où le  |w| < masse partout.
     1002c     Version d'origine
     1003c     Pourrait etre enleve si on voit que le code plus general
     1004c     est aussi rapide
    9721005c ---------------------------------------------------------------
    9731006
     
    9911024c$OMP END DO NOWAIT   
    9921025       !write(*,*) 'vlz 1001'   
     1026
     1027      ELSE ! countcfl>=1
     1028
     1029      PRINT*,'vlz passage dans le non local'
     1030c ---------------------------------------------------------------
     1031c  Debut du traitement du cas ou on viole le CFL : w > masse
     1032c ---------------------------------------------------------------
     1033
     1034c Initialisation
     1035
     1036c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1037       DO l = 2,llm
     1038         DO ij = ijb,ije
     1039            wresi(ij,l)=w(ij,l,iq)
     1040            wq(ij,l,iq)=0.
     1041            IF(w(ij,l,iq).gt.0.) THEN
     1042               lorig(ij,l)=l
     1043               morig(ij,l)=masse(ij,l,iq)
     1044               qorig(ij,l)=q(ij,l,iq)
     1045               dzqorig(ij,l)=dzq(ij,l)
     1046            ELSE
     1047               lorig(ij,l)=l-1
     1048               morig(ij,l)=masse(ij,l-1,iq)
     1049               qorig(ij,l)=q(ij,l-1,iq)
     1050               dzqorig(ij,l)=dzq(ij,l-1)
     1051            ENDIF
     1052         ENDDO
     1053       ENDDO
     1054c$OMP END DO NO WAIT
     1055
     1056c Reindicage vertical en accumulant les flux sur
     1057c  les mailles qui viollent le CFL
     1058c  on itère jusqu'à ce que tous les poins satisfassent
     1059c  le critère
     1060      DO WHILE (countcfl>=1)
     1061      print*,'On viole le CFL Vertical sur ',countcfl,' pts'
     1062      countcfl=0
     1063
     1064c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1065      DO l = 2,llm
     1066         DO ij = ijb,ije
     1067          IF (ABS(wresi(ij,l))>morig(ij,l)) THEN
     1068             countcfl=countcfl+1
     1069! rm : les 8 lignes ci dessous pourraient sans doute s'ecrire
     1070! avec la fonction sign
     1071             IF(w(ij,l,iq)>0.) THEN
     1072                wresi(ij,l)=wresi(ij,l)-morig(ij,l)
     1073                wq(ij,l,iq)=wq(ij,l,iq)+morig(ij,l)*qorig(ij,l)
     1074                lorig(ij,l)=lorig(ij,l)+1
     1075             ELSE
     1076                wresi(ij,l)=wresi(ij,l)+morig(ij,l)
     1077                wq(ij,l,iq)=wq(ij,l,iq)-morig(ij,l)*qorig(ij,l)
     1078                lorig(ij,l)=lorig(ij,l)-1
     1079             ENDIF
     1080             morig(ij,l)=masse(ij,lorig(ij,l),iq)
     1081             qorig(ij,l)=q(ij,lorig(ij,l),iq)
     1082             dzqorig(ij,l)=dzq(ij,lorig(ij,l))
     1083          ENDIF
     1084         ENDDO
     1085      ENDDO
     1086c$OMP END DO NO WAIT
     1087
     1088      ENDDO ! WHILE (countcfl>=1)
     1089
     1090c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1091       DO l = 2,llm
     1092         do  ij = ijb,ije
     1093          sigw=wresi(ij,l)/morig(ij,l)
     1094          IF(w(ij,l,iq).gt.0.) THEN
     1095             wq(ij,l,iq)=wq(ij,l,iq)+wresi(ij,l)*(qorig(ij,l)
     1096     :           +0.5*(1.-sigw)*dzqorig(ij,l))
     1097          ELSE
     1098             wq(ij,l,iq)=wq(ij,l,iq)+wresi(ij,l)*(qorig(ij,l)
     1099     :           -0.5*(1.+sigw)*dzqorig(ij,l))
     1100          ENDIF
     1101         ENDDO
     1102       ENDDO
     1103c$OMP END DO NOWAIT   
     1104
     1105
     1106       ENDIF ! councfl=0
     1107
     1108
    9931109
    9941110c$OMP MASTER
Note: See TracChangeset for help on using the changeset viewer.