Changeset 5246 for LMDZ6/trunk/libf/dyn3dmem/dteta1_loc.f90
- Timestamp:
- Oct 21, 2024, 2:58:45 PM (23 hours ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3dmem/dteta1_loc.f90
r5245 r5246 1 2 3 4 5 1 SUBROUTINE dteta1_loc ( teta, pbaru, pbarv, dteta) 2 USE parallel_lmdz 3 USE write_field_p 4 USE mod_filtreg_p 5 IMPLICIT NONE 6 6 7 c=======================================================================8 c 9 cAuteur: P. Le Van10 c-------11 cModif F.Forget 03/94 (on retire q et dq pour construire dteta1)12 c 13 c********************************************************************14 c... calcul du terme de convergence horizontale du flux d'enthalpie15 cpotentielle ......16 c********************************************************************17 c.. teta,pbaru et pbarv sont des arguments d'entree pour le s-pg ....18 cdteta sont des arguments de sortie pour le s-pg ....19 c 20 c=======================================================================7 !======================================================================= 8 ! 9 ! Auteur: P. Le Van 10 ! ------- 11 ! Modif F.Forget 03/94 (on retire q et dq pour construire dteta1) 12 ! 13 ! ******************************************************************** 14 ! ... calcul du terme de convergence horizontale du flux d'enthalpie 15 ! potentielle ...... 16 ! ******************************************************************** 17 ! .. teta,pbaru et pbarv sont des arguments d'entree pour le s-pg .... 18 ! dteta sont des arguments de sortie pour le s-pg .... 19 ! 20 !======================================================================= 21 21 22 22 23 24 23 include "dimensions.h" 24 include "paramet.h" 25 25 26 REALteta( ijb_u:ije_u,llm )27 REALpbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm)28 REALdteta( ijb_u:ije_u,llm )29 INTEGERl,ij26 REAL :: teta( ijb_u:ije_u,llm ) 27 REAL :: pbaru( ijb_u:ije_u,llm ),pbarv( ijb_v:ije_v,llm) 28 REAL :: dteta( ijb_u:ije_u,llm ) 29 INTEGER :: l,ij 30 30 31 REALhbyv( ijb_v:ije_v,llm ), hbxu( ijb_u:ije_u,llm )31 REAL :: hbyv( ijb_v:ije_v,llm ), hbxu( ijb_u:ije_u,llm ) 32 32 33 c 34 INTEGER ijb,ije,jjb,jje 35 36 37 jjb=jj_begin 38 jje=jj_end 39 40 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 41 DO 5 l = 1,llm 42 43 ijb=ij_begin 44 ije=ij_end 45 46 if (pole_nord) ijb=ij_begin+iip1 47 if (pole_sud) ije=ij_end-iip1 48 49 DO 1 ij = ijb, ije - 1 50 hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l)+teta(ij+1,l) ) 51 1 CONTINUE 52 53 c .... correction pour hbxu(iip1,j,l) ..... 54 c .... hbxu(iip1,j,l)= hbxu(1,j,l) .... 55 56 CDIR$ IVDEP 57 DO 2 ij = ijb+iip1-1, ije, iip1 58 hbxu( ij, l ) = hbxu( ij - iim, l ) 59 2 CONTINUE 60 61 ijb=ij_begin-iip1 62 if (pole_nord) ijb=ij_begin 63 64 DO 3 ij = ijb,ije 65 hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+teta(ij+iip1,l) ) 66 3 CONTINUE 67 68 if (.not. pole_sud) then 69 hbxu(ije+1:ije+iip1,l) = 0 70 hbyv(ije+1:ije+iip1,l) = 0 71 endif 72 73 5 CONTINUE 74 c$OMP END DO NOWAIT 75 76 77 CALL convflu_loc ( hbxu, hbyv, llm, dteta ) 33 ! 34 INTEGER :: ijb,ije,jjb,jje 78 35 79 36 80 c stockage dans dh de la convergence horizont. filtree' du flux 81 c .... ........... 82 c d'enthalpie potentielle . 83 84 85 CALL filtreg_p( dteta,jjb_u,jje_u,jjb,jje,jjp1, llm, 86 & 2, 2, .true., 1) 87 88 89 RETURN 90 END 37 jjb=jj_begin 38 jje=jj_end 39 40 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 41 DO l = 1,llm 42 43 ijb=ij_begin 44 ije=ij_end 45 46 if (pole_nord) ijb=ij_begin+iip1 47 if (pole_sud) ije=ij_end-iip1 48 49 DO ij = ijb, ije - 1 50 hbxu(ij,l) = pbaru(ij,l) * 0.5 * ( teta(ij,l)+teta(ij+1,l) ) 51 END DO 52 53 ! .... correction pour hbxu(iip1,j,l) ..... 54 ! .... hbxu(iip1,j,l)= hbxu(1,j,l) .... 55 56 !DIR$ IVDEP 57 DO ij = ijb+iip1-1, ije, iip1 58 hbxu( ij, l ) = hbxu( ij - iim, l ) 59 END DO 60 61 ijb=ij_begin-iip1 62 if (pole_nord) ijb=ij_begin 63 64 DO ij = ijb,ije 65 hbyv(ij,l)= pbarv(ij, l)* 0.5 * ( teta(ij, l)+teta(ij+iip1,l) ) 66 END DO 67 68 if (.not. pole_sud) then 69 hbxu(ije+1:ije+iip1,l) = 0 70 hbyv(ije+1:ije+iip1,l) = 0 71 endif 72 73 END DO 74 !$OMP END DO NOWAIT 75 76 77 CALL convflu_loc ( hbxu, hbyv, llm, dteta ) 78 79 80 ! stockage dans dh de la convergence horizont. filtree' du flux 81 ! .... ........... 82 ! d'enthalpie potentielle . 83 84 85 CALL filtreg_p( dteta,jjb_u,jje_u,jjb,jje,jjp1, llm, & 86 2, 2, .true., 1) 87 88 89 RETURN 90 END SUBROUTINE dteta1_loc
Note: See TracChangeset
for help on using the changeset viewer.