/[MITgcm]/MITgcm_contrib/darwin2/pkg/darwin/wavebands_init_vari.F
ViewVC logotype

Annotation of /MITgcm_contrib/darwin2/pkg/darwin/wavebands_init_vari.F

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


Revision 1.1 - (hide annotations) (download)
Wed Apr 13 18:56:25 2011 UTC (14 years, 3 months ago) by jahn
Branch: MAIN
CVS Tags: ctrb_darwin2_ckpt64k_20130723, ctrb_darwin2_ckpt63l_20120405, ctrb_darwin2_ckpt64h_20130528, ctrb_darwin2_ckpt62v_20110413, ctrb_darwin2_ckpt64m_20130820, ctrb_darwin2_ckpt64f_20130405, ctrb_darwin2_ckpt63f_20111201, ctrb_darwin2_ckpt64a_20121116, ctrb_darwin2_ckpt64n_20130826, ctrb_darwin2_ckpt64o_20131024, ctrb_darwin2_ckpt62y_20110526, ctrb_darwin2_ckpt64i_20130622, ctrb_darwin2_ckpt62x_20110513, ctrb_darwin2_ckpt62w_20110426, ctrb_darwin2_ckpt63o_20120629, ctrb_darwin2_ckpt64e_20130305, ctrb_darwin2_ckpt63c_20111011, ctrb_darwin2_ckpt63i_20120124, ctrb_darwin2_ckpt63m_20120506, ctrb_darwin2_ckpt63s_20120908, ctrb_darwin2_ckpt63e_20111107, ctrb_darwin2_ckpt63b_20110830, ctrb_darwin2_ckpt63j_20120217, ctrb_darwin2_ckpt63r_20120817, ctrb_darwin2_ckpt64g_20130503, ctrb_darwin2_ckpt64l_20130806, ctrb_darwin2_ckpt63g_20111220, ctrb_darwin2_ckpt64c_20130120, ctrb_darwin2_ckpt63a_20110804, ctrb_darwin2_ckpt64j_20130704, ctrb_darwin2_ckpt63h_20111230, ctrb_darwin2_ckpt63p_20120707, ctrb_darwin2_ckpt64p_20131118, ctrb_darwin2_ckpt63d_20111107, ctrb_darwin2_ckpt63q_20120731, ctrb_darwin2_ckpt63_20110728, ctrb_darwin2_ckpt64b_20121224, ctrb_darwin2_ckpt64d_20130219, ctrb_darwin2_ckpt64_20121012, ctrb_darwin2_ckpt64q_20131118, ctrb_darwin2_baseline, ctrb_darwin2_ckpt64p_20131024, ctrb_darwin2_ckpt63n_20120604, ctrb_darwin2_ckpt63k_20120317, ctrb_darwin2_ckpt62z_20110622
darwin2 initial checkin

1 jahn 1.1 C $Header$
2     C $Name$
3    
4     c ANNA wavebands_init_vari.F assigns actual values to choices made by coin-flips in darwin_generate_phyto.F
5     c ANNA wavebands_init_vari.F creates output files
6    
7     #include "DARWIN_OPTIONS.h"
8    
9     CBOP
10     C !ROUTINE: WAVEBANDS_INIT_VARI
11     C !INTERFACE:
12     SUBROUTINE WAVEBANDS_INIT_VARI(myThid)
13    
14     C !DESCRIPTION: \bv
15     C *==========================================================*
16     C | SUBROUTINE WAVEBANDS_INIT_VARI
17     C | o assigns actual values to choices made by coin-flips
18     C | in darwin_generate_phyto.F; creates output files
19     C *==========================================================*
20     C \ev
21    
22     C !USES:
23     implicit none
24     C == Global variables ===
25     #include "DARWIN_SIZE.h"
26     #include "SPECTRAL_SIZE.h"
27     #ifdef WAVEBANDS
28     #include "WAVEBANDS_PARAMS.h"
29     #endif
30    
31     C !INPUT/OUTPUT PARAMETERS:
32     C == Routine arguments ==
33     C myThid :: my Thread Id number
34     INTEGER myThid
35     CEOP
36    
37     #ifdef WAVEBANDS
38    
39     C !LOCAL VARIABLES:
40     C == Local variables ==
41     _RL outfile(npmax,tlam)
42     _RL outfile_ps(npmax,tlam)
43    
44     INTEGER np,nl,i,ilam, nap
45     INTEGER IniUnit1, IniUnit2, IniUnit3
46     INTEGER IniUnit4, IniUnit5, IniUnit6
47     INTEGER IniUnit7
48    
49    
50     c ANNA associate the pigment / abs choices for phytoplankton with actual absorption spectra
51     c make sure pigment types and actual spectra match - here keep 1-4 in same order as datafile
52     do np = 1, npmax
53    
54     do nap=1, tnabp
55     if (ap_type(np).eq.nap) then
56     do i = 1,tlam
57     aphy_chl(np,i) = ap(nap,i)
58     aphy_chl_ps(np,i) = ap_ps(nap,i)
59     #ifdef DAR_RADTRANS
60     bphy_chl(np,i) = bp(nap,i)
61     #ifdef DAR_NONSPECTRAL_BACKSCATTERING_RATIO
62     bbphy_chl(np,i) = bp(nap,i)*darwin_bbphy(nap)
63     #else
64     bbphy_chl(np,i) = bbp(nap,i)
65     #endif
66     #endif
67     enddo
68     endif
69     enddo
70    
71     c checking the output .dat file will reveal this
72     if(ap_type(np).eq.0) then
73     do i=1,tlam
74     aphy_chl(np,i) = 9.9d2
75     aphy_chl_ps(np,i) = 9.9d2
76     #ifdef DAR_RADTRANS
77     bphy_chl(np,i) = 9.9d2
78     bbphy_chl(np,i) = 9.9d2
79     #endif
80     enddo
81     endif
82    
83     enddo
84    
85     c ANNA create output files for WAVEBANDS
86     c ANNA see format_helps folder for more info on file structures
87    
88     c file for ap_types assigned via coin flips
89     CALL MDSFINDUNIT( IniUnit1, mythid )
90     open(IniUnit1,file='p-ini-char-aptype.dat',
91     & status='unknown')
92     CALL MDSFINDUNIT( IniUnit2, mythid )
93     open(IniUnit2,file='p_ini_char_aptype_nohead.dat',
94     & status='unknown')
95     write(IniUnit1,*)'np ap_type' !to have bp_type for backscattering too
96     do np = 1,npmax
97     write(IniUnit1,120)np,ap_type(np)
98     write(IniUnit2,120)np,ap_type(np)
99     enddo
100     close(IniUnit1)
101     close(IniUnit2)
102     120 format(2i5)
103    
104     c file of total absorption spectra
105     c rows = pwaves, columns = np
106     do np=1,npmax
107     do ilam=1,tlam
108     outfile(np,ilam) = aphy_chl(np,ilam)
109     enddo
110     enddo
111     CALL MDSFINDUNIT( IniUnit3, mythid )
112     open(IniUnit3,file='p-ini-char-apspec.dat',
113     & status='unknown')
114     CALL MDSFINDUNIT( IniUnit4, mythid )
115     open(IniUnit4,file='p_ini_char_aspec_nohead.dat',
116     & status='unknown')
117     write(IniUnit3,*)'Rows = pwaves. Columns = np'
118     write(IniUnit3,*)'pwaves found in pwaves-check.dat'
119     write(IniUnit3,*)'col_1 to col_<npmax>'
120     write(IniUnit3,*)'is absorption aphy_chl (m-2 mg chla-1)'
121     do ilam=1,tlam
122     write(IniUnit3,130)(outfile(np,ilam),np=1,npmax)
123     write(IniUnit4,130)(outfile(np,ilam),np=1,npmax)
124     enddo
125     c make sure outfile is defined above with the correct size
126     close(IniUnit3)
127     close(IniUnit4)
128    
129     c file for absorption spectra of PS's only
130     c rows = pwaves, columns = np
131     do np=1,npmax
132     do ilam=1,tlam
133     outfile_ps(np,ilam) = aphy_chl_ps(np,ilam)
134     enddo
135     enddo
136     CALL MDSFINDUNIT( IniUnit5, mythid )
137     open( IniUnit5,file='p-ini-char-apspec-psc.dat',
138     & status='unknown')
139     CALL MDSFINDUNIT( IniUnit6, mythid )
140     open( IniUnit6,file='p_ini_char_aspec_psc_nohead.dat',
141     & status='unknown')
142     write(IniUnit5,*)'Rows = pwaves. Columns = np'
143     write(IniUnit5,*)'pwaves found in pwaves-check.dat'
144     write(IniUnit5,*)'Is absoprtion by photosynthetic'
145     write(IniUnit5,*)'pigments only aphy_chl_ps (m-2 mg chla-1)'
146     do ilam=1,tlam
147     write(IniUnit5,130)(outfile_ps(np,ilam),np=1,npmax)
148     write(IniUnit6,130)(outfile_ps(np,ilam),np=1,npmax)
149     enddo
150     close(IniUnit5)
151     close(IniUnit6)
152     130 format(9999f10.4)
153    
154    
155     c file for wavebands used
156     c open(23,file='pwaves-check.dat',status='new')
157     CALL MDSFINDUNIT( IniUnit7, mythid )
158     open( IniUnit7,file='pwaves-check.dat',
159     & status='unknown')
160     write(IniUnit7,140)pwaves
161     close(IniUnit7)
162     140 format(i5)
163    
164    
165     #endif
166    
167     return
168     end

  ViewVC Help
Powered by ViewVC 1.1.22