1 |
|
|
! |
2 |
|
|
! $Header$ |
3 |
|
|
! |
4 |
|
865 |
SUBROUTINE gr_dyn_fi(nfield,im,jm,ngrid,pdyn,pfi) |
5 |
|
|
IMPLICIT NONE |
6 |
|
|
c======================================================================= |
7 |
|
|
c passage d'un champ de la grille scalaire a la grille physique |
8 |
|
|
c======================================================================= |
9 |
|
|
|
10 |
|
|
c----------------------------------------------------------------------- |
11 |
|
|
c declarations: |
12 |
|
|
c ------------- |
13 |
|
|
|
14 |
|
|
INTEGER im,jm,ngrid,nfield |
15 |
|
|
REAL pdyn(im,jm,nfield) |
16 |
|
|
REAL pfi(ngrid,nfield) |
17 |
|
|
|
18 |
|
|
INTEGER j,ifield,ig |
19 |
|
|
|
20 |
|
|
c----------------------------------------------------------------------- |
21 |
|
|
c calcul: |
22 |
|
|
c ------- |
23 |
|
|
|
24 |
✗✓ |
865 |
IF (ngrid.NE.2+(jm-2)*(im-1)) then |
25 |
|
|
call abort_gcm("gr_dyn_fi", 'probleme de dim', 1) |
26 |
|
|
end if |
27 |
|
|
c traitement des poles |
28 |
|
865 |
CALL SCOPY(nfield,pdyn,im*jm,pfi,ngrid) |
29 |
|
865 |
CALL SCOPY(nfield,pdyn(1,jm,1),im*jm,pfi(ngrid,1),ngrid) |
30 |
|
|
|
31 |
|
|
c traitement des point normaux |
32 |
✓✓ |
23618 |
DO ifield=1,nfield |
33 |
✓✓ |
728961 |
DO j=2,jm-1 |
34 |
|
705343 |
ig=2+(j-2)*(im-1) |
35 |
|
728096 |
CALL SCOPY(im-1,pdyn(1,j,ifield),1,pfi(ig,ifield),1) |
36 |
|
|
ENDDO |
37 |
|
|
ENDDO |
38 |
|
|
|
39 |
|
865 |
RETURN |
40 |
|
|
END |