Changeset 5246 for LMDZ6/trunk/libf/dyn3dmem/nxgraro2_loc.f90
- Timestamp:
- Oct 21, 2024, 2:58:45 PM (23 hours ago)
- File:
-
- 1 moved
-
LMDZ6/trunk/libf/dyn3dmem/nxgraro2_loc.f90 (moved) (moved from LMDZ6/trunk/libf/dyn3dmem/nxgraro2_loc.F) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/trunk/libf/dyn3dmem/nxgraro2_loc.f90
r5245 r5246 1 2 c 3 cP.Le Van .4 c***********************************************************5 clr6 ccalcul de ( nxgrad (rot) ) du vect. v ....7 c 8 cxcov et ycov etant les compos. covariantes de v9 c***********************************************************10 cxcov , ycov et lr sont des arguments d'entree pour le s-prog11 cgrx et gry sont des arguments de sortie pour le s-prog12 c 13 c 14 15 16 17 18 19 20 21 c 22 23 24 25 c 26 c...... variables en arguments .......27 c 28 INTEGERklevel29 REALxcov( ijb_u:ije_u,klevel ), ycov( ijb_v:ije_v,klevel )30 REALgrx_out( ijb_u:ije_u,klevel ),gry_out(ijb_v:ije_v,klevel)31 c 32 c...... variables locales ........33 c 34 REALsigne, nugradrs35 INTEGERl,ij,iter,lr36 1 SUBROUTINE nxgraro2_loc(klevel,xcov,ycov,lr,grx_out,gry_out) 2 ! 3 ! P.Le Van . 4 ! *********************************************************** 5 ! lr 6 ! calcul de ( nxgrad (rot) ) du vect. v .... 7 ! 8 ! xcov et ycov etant les compos. covariantes de v 9 ! *********************************************************** 10 ! xcov , ycov et lr sont des arguments d'entree pour le s-prog 11 ! grx et gry sont des arguments de sortie pour le s-prog 12 ! 13 ! 14 USE write_Field_p 15 USE parallel_lmdz 16 USE times 17 USE mod_hallo 18 USE mod_filtreg_p 19 USE nxgraro2_mod 20 IMPLICIT NONE 21 ! 22 INCLUDE "dimensions.h" 23 INCLUDE "paramet.h" 24 INCLUDE "comdissipn.h" 25 ! 26 ! ...... variables en arguments ....... 27 ! 28 INTEGER :: klevel 29 REAL :: xcov( ijb_u:ije_u,klevel ), ycov( ijb_v:ije_v,klevel ) 30 REAL :: grx_out( ijb_u:ije_u,klevel ),gry_out(ijb_v:ije_v,klevel) 31 ! 32 ! ...... variables locales ........ 33 ! 34 REAL :: signe, nugradrs 35 INTEGER :: l,ij,iter,lr 36 Type(Request),SAVE :: Request_dissip 37 37 !$OMP THREADPRIVATE(Request_dissip) 38 c ........................................................ 39 c 40 INTEGER :: ijb,ije,jjb,jje 41 42 c 43 c 44 signe = (-1.)**lr 45 nugradrs = signe * crot 46 c 47 c CALL SCOPY ( ip1jmp1* klevel, xcov, 1, grx, 1 ) 48 c CALL SCOPY ( ip1jm * klevel, ycov, 1, gry, 1 ) 49 50 ijb=ij_begin 51 ije=ij_end 38 ! ........................................................ 39 ! 40 INTEGER :: ijb,ije,jjb,jje 52 41 53 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 54 DO l = 1, klevel 55 grx(ijb:ije,l)=xcov(ijb:ije,l) 56 ENDDO 57 c$OMP END DO NOWAIT 42 ! 43 ! 44 signe = (-1.)**lr 45 nugradrs = signe * crot 46 ! 47 ! CALL SCOPY ( ip1jmp1* klevel, xcov, 1, grx, 1 ) 48 ! CALL SCOPY ( ip1jm * klevel, ycov, 1, gry, 1 ) 58 49 59 c$OMP BARRIER 60 call Register_Hallo_u(grx,llm,0,1,1,0,Request_dissip) 61 call SendRequest(Request_dissip) 62 c$OMP BARRIER 63 call WaitRequest(Request_dissip) 64 c$OMP BARRIER 50 ijb=ij_begin 51 ije=ij_end 65 52 66 ijb=ij_begin 67 ije=ij_end 68 if(pole_sud) ije=ij_end-iip1 53 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 54 DO l = 1, klevel 55 grx(ijb:ije,l)=xcov(ijb:ije,l) 56 ENDDO 57 !$OMP END DO NOWAIT 69 58 70 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 71 DO l = 1, klevel 72 gry(ijb:ije,l)=ycov(ijb:ije,l) 73 ENDDO 74 c$OMP END DO NOWAIT 75 76 c 77 CALL rotatf_loc ( klevel, grx, gry, rot ) 78 c call write_field3d_p('rot1',reshape(rot,(/iip1,jjm,llm/))) 59 !$OMP BARRIER 60 call Register_Hallo_u(grx,llm,0,1,1,0,Request_dissip) 61 call SendRequest(Request_dissip) 62 !$OMP BARRIER 63 call WaitRequest(Request_dissip) 64 !$OMP BARRIER 79 65 80 c$OMP BARRIER 81 call Register_Hallo_v(rot,llm,1,1,1,1,Request_dissip) 82 call SendRequest(Request_dissip) 83 c$OMP BARRIER 84 call WaitRequest(Request_dissip) 85 c$OMP BARRIER 86 87 CALL laplacien_rot_loc ( klevel, rot, rot,grx,gry ) 88 c call write_field3d_p('rot2',reshape(rot,(/iip1,jjm,llm/))) 89 c 90 c ..... Iteration de l'operateur laplacien_rotgam ..... 91 c 92 DO iter = 1, lr -2 93 c$OMP BARRIER 94 call Register_Hallo_v(rot,llm,1,1,1,1,Request_dissip) 95 call SendRequest(Request_dissip) 96 c$OMP BARRIER 97 call WaitRequest(Request_dissip) 98 c$OMP BARRIER 66 ijb=ij_begin 67 ije=ij_end 68 if(pole_sud) ije=ij_end-iip1 99 69 100 CALL laplacien_rotgam_loc( klevel, rot, rot ) 101 ENDDO 102 103 c call write_field3d_p('rot3',reshape(rot,(/iip1,jjm,llm/))) 104 105 c 106 c 107 jjb=jj_begin 108 jje=jj_end 109 if (pole_sud) jje=jj_end-1 110 111 CALL filtreg_p( rot, jjb_v,jje_v, jjb,jje,jjm, 112 & klevel, 2,1, .FALSE.,1) 113 c$OMP BARRIER 114 call Register_Hallo_v(rot,llm,1,0,0,1,Request_dissip) 115 call SendRequest(Request_dissip) 116 c$OMP BARRIER 117 call WaitRequest(Request_dissip) 118 c$OMP BARRIER 70 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 71 DO l = 1, klevel 72 gry(ijb:ije,l)=ycov(ijb:ije,l) 73 ENDDO 74 !$OMP END DO NOWAIT 119 75 120 CALL nxgrad_loc ( klevel, rot, grx, gry ) 76 ! 77 CALL rotatf_loc ( klevel, grx, gry, rot ) 78 ! call write_field3d_p('rot1',reshape(rot,(/iip1,jjm,llm/))) 121 79 122 c 123 ijb=ij_begin 124 ije=ij_end 125 126 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 127 DO l = 1, klevel 128 129 if(pole_sud) ije=ij_end-iip1 130 DO ij = ijb, ije 131 gry_out( ij,l ) = gry( ij,l ) * nugradrs 132 ENDDO 133 134 if(pole_sud) ije=ij_end 135 DO ij = ijb, ije 136 grx_out( ij,l ) = grx( ij,l ) * nugradrs 137 ENDDO 138 139 ENDDO 140 c$OMP END DO NOWAIT 141 c 142 RETURN 143 END 80 !$OMP BARRIER 81 call Register_Hallo_v(rot,llm,1,1,1,1,Request_dissip) 82 call SendRequest(Request_dissip) 83 !$OMP BARRIER 84 call WaitRequest(Request_dissip) 85 !$OMP BARRIER 86 87 CALL laplacien_rot_loc ( klevel, rot, rot,grx,gry ) 88 ! call write_field3d_p('rot2',reshape(rot,(/iip1,jjm,llm/))) 89 ! 90 ! ..... Iteration de l'operateur laplacien_rotgam ..... 91 ! 92 DO iter = 1, lr -2 93 !$OMP BARRIER 94 call Register_Hallo_v(rot,llm,1,1,1,1,Request_dissip) 95 call SendRequest(Request_dissip) 96 !$OMP BARRIER 97 call WaitRequest(Request_dissip) 98 !$OMP BARRIER 99 100 CALL laplacien_rotgam_loc( klevel, rot, rot ) 101 ENDDO 102 103 ! call write_field3d_p('rot3',reshape(rot,(/iip1,jjm,llm/))) 104 105 ! 106 ! 107 jjb=jj_begin 108 jje=jj_end 109 if (pole_sud) jje=jj_end-1 110 111 CALL filtreg_p( rot, jjb_v,jje_v, jjb,jje,jjm, & 112 klevel, 2,1, .FALSE.,1) 113 !$OMP BARRIER 114 call Register_Hallo_v(rot,llm,1,0,0,1,Request_dissip) 115 call SendRequest(Request_dissip) 116 !$OMP BARRIER 117 call WaitRequest(Request_dissip) 118 !$OMP BARRIER 119 120 CALL nxgrad_loc ( klevel, rot, grx, gry ) 121 122 ! 123 ijb=ij_begin 124 ije=ij_end 125 126 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 127 DO l = 1, klevel 128 129 if(pole_sud) ije=ij_end-iip1 130 DO ij = ijb, ije 131 gry_out( ij,l ) = gry( ij,l ) * nugradrs 132 ENDDO 133 134 if(pole_sud) ije=ij_end 135 DO ij = ijb, ije 136 grx_out( ij,l ) = grx( ij,l ) * nugradrs 137 ENDDO 138 139 ENDDO 140 !$OMP END DO NOWAIT 141 ! 142 RETURN 143 END SUBROUTINE nxgraro2_loc
Note: See TracChangeset
for help on using the changeset viewer.
