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

Contents 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 - (show annotations) (download)
Wed Apr 13 18:56:25 2011 UTC (14 years, 4 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 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