/[MITgcm]/MITgcm/pkg/atm_ocn_coupler/set_runoffmap.F
ViewVC logotype

Annotation of /MITgcm/pkg/atm_ocn_coupler/set_runoffmap.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (hide annotations) (download)
Thu Jun 15 23:05:26 2006 UTC (18 years ago) by jmc
Branch: MAIN
rename pkg aim_ocn_coupler to atm_ocn_coupler (later on, will be used without aim)

1 jmc 1.1 C $Header: /u/gcmpack/MITgcm/pkg/aim_ocn_coupler/set_runoffmap.F,v 1.1 2003/12/15 02:28:01 jmc Exp $
2     C $Name: $
3    
4     #include "CPP_OPTIONS.h"
5    
6     CStartOfInterface
7     SUBROUTINE SET_RUNOFFMAP
8     C *==========================================================*
9     C | SUBROUTINE SET_RUNOFFMAP
10     C | o define runoff mapping from atmos. grid (land) to
11     C | ocean grid
12     C *==========================================================*
13     IMPLICIT NONE
14    
15     #include "ATMSIZE.h"
16     #include "OCNSIZE.h"
17     #include "CPL_MAP2GRIDS.h"
18    
19     C == Routine arguments ==
20     CEndOfInterface
21    
22     C == Local variables ==
23     INTEGER n, ijo, ija
24     INTEGER lengthName, lengthRec, iRec
25     Real*8 r8seg(3)
26     Real*8 tmpfld(3,ROsize), rAc(Nx_ocn*Ny_ocn)
27    
28     C- Initialize to zero :
29     DO n=1,ROsize
30     ijROocn(n)=0
31     ijROatm(n)=0
32     arROmap(n)=0.
33     ENDDO
34    
35     C- Read (ocean) grid cell area from file ;
36     lengthRec=Nx_ocn*Ny_ocn*WORDLENGTH*2
37     OPEN(88, FILE='RA.bin', STATUS='OLD',
38     & ACCESS='direct', RECL=lengthRec )
39     iRec = 1
40     READ(88,rec=iRec) rAc
41     CLOSE(88)
42     #ifdef _BYTESWAPIO
43     CALL MDS_BYTESWAPR8( Nx_ocn*Ny_ocn, rAc )
44     #endif
45     c write(6,*) 'rAc=', rAc(1), rAc(17), rAc(17+16*Nx_ocn)
46    
47     c lengthName=ILNBLNK( runoffmapFile ) ! eesup/src/utils.F not compiled here
48     lengthName=0
49     DO n=1,LEN( runoffmapFile )
50     IF ( runoffmapFile(n:n).NE.' ' ) lengthName=n
51     ENDDO
52     write(6,'(3A,I6)') ' runoffmapFile =>>',
53     & runoffmapFile(1:lengthName),'<<= , nROmap=',nROmap
54     IF ( lengthName.EQ.0 ) nROmap=0
55     IF ( nROmap.EQ.0 ) RETURN
56    
57     C- Read area catchment from file ;
58     c lengthRec=3*nROmap*WORDLENGTH*2
59     c OPEN(88, FILE=runoffmapFile(1:lengthName), STATUS='OLD',
60     c & ACCESS='direct', RECL=lengthRec )
61     c READ(88,rec=1) tmpfld
62     lengthRec=3*WORDLENGTH*2
63     OPEN(88, FILE=runoffmapFile(1:lengthName), STATUS='OLD',
64     & ACCESS='direct', RECL=lengthRec )
65     DO n=1,nROmap
66     iRec = n
67     READ(88,rec=iRec) r8seg
68     tmpfld(1,n)=r8seg(1)
69     tmpfld(2,n)=r8seg(2)
70     tmpfld(3,n)=r8seg(3)
71     ENDDO
72     CLOSE(88)
73     #ifdef _BYTESWAPIO
74     CALL MDS_BYTESWAPR8( 3*nROmap, tmpfld )
75     #endif
76     c n=nROmap
77     c write(6,'(A,3I5,F11.6)') 'ROmap:',n,nint(tmpfld(1,n)),
78     c & NINT(tmpfld(2,n)),tmpfld(3,n)*1.d-9
79    
80     C----------------------------------------------------------
81    
82     C- Define mapping :
83     DO n=1,nROmap
84     ija=NINT(tmpfld(1,n))
85     ijo=NINT(tmpfld(2,n))
86     IF ( ija.LT.1 .OR. ija.GT.Nx_atm*Ny_atm ) THEN
87     WRITE(0,*)'SET_RUNOFFMAP: ijROatm out of range !'
88     STOP 'ABNORMAL END: S/R ATM_TO_OCN_MAPRUNOFF'
89     ENDIF
90     ijROatm(n)=ija
91     IF ( ijo.LT.1 .OR. ijo.GT.Nx_ocn*Ny_ocn ) THEN
92     write(0,*)'SET_RUNOFFMAP: ijROocn out of range !'
93     STOP 'ABNORMAL END: S/R SET_RUNOFFMAP'
94     ELSEIF ( rAc(ijo).GT.0. ) THEN
95     arROmap(n)=tmpfld(3,n)/rAc(ijo);
96     ENDIF
97     ijROocn(n)=ijo
98     ENDDO
99    
100     C- print to check :
101     n=1
102     write(6,'(A,3I5,F9.6)') ' ROmap:',
103     & n,ijROatm(n),ijROocn(n),arROmap(n)
104     n=nROmap
105     write(6,'(A,3I5,F9.6)') ' ROmap:',
106     & n,ijROatm(n),ijROocn(n),arROmap(n)
107    
108     RETURN
109     END

  ViewVC Help
Powered by ViewVC 1.1.22