- Timestamp:
- Jan 19, 2017, 3:15:40 PM (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ5/trunk/libf/dyn3dmem/vlsplt_loc.F
r2603 r2765 885 885 c 886 886 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) 887 892 c 888 893 REAL newmasse … … 911 916 ! vlz_loc si on veut qu'elles soient vues par tous les threads. 912 917 INTEGER ifils,iq2 ! CRisi 918 913 919 914 920 IF (first) THEN … … 968 974 ENDIF 969 975 #endif 976 977 !-------------------------------------------------------- 978 ! On repere les points qui violent le CFL (|w| > masse) 979 !-------------------------------------------------------- 980 981 countcfl=0 982 ! print*,'vlz nouveau' 983 c$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 991 c$OMP END DO NOWAIT 992 993 c --------------------------------------------------------------- 994 c Identification des mailles ou on viole le CFL : w > masse 995 c --------------------------------------------------------------- 996 997 IF (countcfl==0) THEN 998 970 999 c --------------------------------------------------------------- 971 1000 c .... calcul des termes d'advection verticale ....... 1001 c Dans le cas où le |w| < masse partout. 1002 c Version d'origine 1003 c Pourrait etre enleve si on voit que le code plus general 1004 c est aussi rapide 972 1005 c --------------------------------------------------------------- 973 1006 … … 991 1024 c$OMP END DO NOWAIT 992 1025 !write(*,*) 'vlz 1001' 1026 1027 ELSE ! countcfl>=1 1028 1029 PRINT*,'vlz passage dans le non local' 1030 c --------------------------------------------------------------- 1031 c Debut du traitement du cas ou on viole le CFL : w > masse 1032 c --------------------------------------------------------------- 1033 1034 c Initialisation 1035 1036 c$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 1054 c$OMP END DO NO WAIT 1055 1056 c Reindicage vertical en accumulant les flux sur 1057 c les mailles qui viollent le CFL 1058 c on itère jusqu'à ce que tous les poins satisfassent 1059 c le critère 1060 DO WHILE (countcfl>=1) 1061 print*,'On viole le CFL Vertical sur ',countcfl,' pts' 1062 countcfl=0 1063 1064 c$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 1086 c$OMP END DO NO WAIT 1087 1088 ENDDO ! WHILE (countcfl>=1) 1089 1090 c$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 1103 c$OMP END DO NOWAIT 1104 1105 1106 ENDIF ! councfl=0 1107 1108 993 1109 994 1110 c$OMP MASTER
Note: See TracChangeset
for help on using the changeset viewer.