/[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.2 - (show annotations) (download)
Wed Dec 4 21:19:12 2013 UTC (11 years, 7 months ago) by jahn
Branch: MAIN
CVS Tags: ctrb_darwin2_ckpt65w_20160512, ctrb_darwin2_ckpt65j_20150225, ctrb_darwin2_ckpt66g_20170424, ctrb_darwin2_ckpt66k_20171025, ctrb_darwin2_ckpt66n_20180118, ctrb_darwin2_ckpt65v_20160409, ctrb_darwin2_ckpt65s_20160114, ctrb_darwin2_ckpt65_20140718, ctrb_darwin2_ckpt66d_20170214, ctrb_darwin2_ckpt64r_20131210, ctrb_darwin2_ckpt65m_20150615, ctrb_darwin2_ckpt65q_20151118, ctrb_darwin2_ckpt65o_20150914, ctrb_darwin2_ckpt65p_20151023, ctrb_darwin2_ckpt65e_20140929, ctrb_darwin2_ckpt64v_20140411, ctrb_darwin2_ckpt64z_20140711, ctrb_darwin2_ckpt65l_20150504, ctrb_darwin2_ckpt65z_20160929, ctrb_darwin2_ckpt65n_20150729, ctrb_darwin2_ckpt64y_20140622, ctrb_darwin2_ckpt65d_20140915, ctrb_darwin2_ckpt64t_20140202, ctrb_darwin2_ckpt66h_20170602, ctrb_darwin2_ckpt64s_20140105, ctrb_darwin2_ckpt64x_20140524, ctrb_darwin2_ckpt65x_20160612, ctrb_darwin2_ckpt66f_20170407, ctrb_darwin2_ckpt65g_20141120, ctrb_darwin2_ckpt65k_20150402, ctrb_darwin2_ckpt64w_20140502, ctrb_darwin2_ckpt66a_20161020, ctrb_darwin2_ckpt65f_20141014, ctrb_darwin2_ckpt66b_20161219, ctrb_darwin2_ckpt64u_20140308, ctrb_darwin2_ckpt65i_20150123, ctrb_darwin2_ckpt66j_20170815, ctrb_darwin2_ckpt65y_20160801, ctrb_darwin2_ckpt66c_20170121, ctrb_darwin2_ckpt65a_20140728, ctrb_darwin2_ckpt65b_20140812, ctrb_darwin2_ckpt65t_20160221, ctrb_darwin2_ckpt66o_20180209, ctrb_darwin2_ckpt66e_20170314, ctrb_darwin2_ckpt65u_20160315, ctrb_darwin2_ckpt65r_20151221, ctrb_darwin2_ckpt66i_20170718, ctrb_darwin2_ckpt65c_20140830, ctrb_darwin2_ckpt66l_20171025, ctrb_darwin2_ckpt65h_20141217, ctrb_darwin2_ckpt66m_20171213, HEAD
Changes since 1.1: +15 -4 lines
only master cpu/thread writes

1 C $Header: /u/gcmpack/MITgcm_contrib/darwin2/pkg/darwin/wavebands_init_vari.F,v 1.1 2011/04/13 18:56:25 jahn Exp $
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 !FUNCTIONS:
40 LOGICAL MASTER_CPU_THREAD
41 EXTERNAL MASTER_CPU_THREAD
42
43 C !LOCAL VARIABLES:
44 C == Local variables ==
45 _RL outfile(npmax,tlam)
46 _RL outfile_ps(npmax,tlam)
47
48 INTEGER np,nl,i,ilam, nap
49 INTEGER IniUnit1, IniUnit2, IniUnit3
50 INTEGER IniUnit4, IniUnit5, IniUnit6
51 INTEGER IniUnit7
52
53
54 c ANNA associate the pigment / abs choices for phytoplankton with actual absorption spectra
55 c make sure pigment types and actual spectra match - here keep 1-4 in same order as datafile
56 do np = 1, npmax
57
58 do nap=1, tnabp
59 if (ap_type(np).eq.nap) then
60 do i = 1,tlam
61 aphy_chl(np,i) = ap(nap,i)
62 aphy_chl_ps(np,i) = ap_ps(nap,i)
63 #ifdef DAR_RADTRANS
64 bphy_chl(np,i) = bp(nap,i)
65 #ifdef DAR_NONSPECTRAL_BACKSCATTERING_RATIO
66 bbphy_chl(np,i) = bp(nap,i)*darwin_bbphy(nap)
67 #else
68 bbphy_chl(np,i) = bbp(nap,i)
69 #endif
70 #endif
71 enddo
72 endif
73 enddo
74
75 c checking the output .dat file will reveal this
76 if(ap_type(np).eq.0) then
77 do i=1,tlam
78 aphy_chl(np,i) = 9.9d2
79 aphy_chl_ps(np,i) = 9.9d2
80 #ifdef DAR_RADTRANS
81 bphy_chl(np,i) = 9.9d2
82 bbphy_chl(np,i) = 9.9d2
83 #endif
84 enddo
85 endif
86
87 enddo
88
89 c ANNA create output files for WAVEBANDS
90 c ANNA see format_helps folder for more info on file structures
91
92 c file for ap_types assigned via coin flips
93 IF (MASTER_CPU_THREAD(myThid)) THEN
94 CALL MDSFINDUNIT( IniUnit1, mythid )
95 open(IniUnit1,file='p-ini-char-aptype.dat',
96 & status='unknown')
97 CALL MDSFINDUNIT( IniUnit2, mythid )
98 open(IniUnit2,file='p_ini_char_aptype_nohead.dat',
99 & status='unknown')
100 write(IniUnit1,*)'np ap_type' !to have bp_type for backscattering too
101 do np = 1,npmax
102 write(IniUnit1,120)np,ap_type(np)
103 write(IniUnit2,120)np,ap_type(np)
104 enddo
105 close(IniUnit1)
106 close(IniUnit2)
107 120 format(2i5)
108 ENDIF
109
110 c file of total absorption spectra
111 c rows = pwaves, columns = np
112 do np=1,npmax
113 do ilam=1,tlam
114 outfile(np,ilam) = aphy_chl(np,ilam)
115 enddo
116 enddo
117 IF (MASTER_CPU_THREAD(myThid)) THEN
118 CALL MDSFINDUNIT( IniUnit3, mythid )
119 open(IniUnit3,file='p-ini-char-apspec.dat',
120 & status='unknown')
121 CALL MDSFINDUNIT( IniUnit4, mythid )
122 open(IniUnit4,file='p_ini_char_aspec_nohead.dat',
123 & status='unknown')
124 write(IniUnit3,*)'Rows = pwaves. Columns = np'
125 write(IniUnit3,*)'pwaves found in pwaves-check.dat'
126 write(IniUnit3,*)'col_1 to col_<npmax>'
127 write(IniUnit3,*)'is absorption aphy_chl (m-2 mg chla-1)'
128 do ilam=1,tlam
129 write(IniUnit3,130)(outfile(np,ilam),np=1,npmax)
130 write(IniUnit4,130)(outfile(np,ilam),np=1,npmax)
131 enddo
132 c make sure outfile is defined above with the correct size
133 close(IniUnit3)
134 close(IniUnit4)
135 ENDIF
136
137 c file for absorption spectra of PS's only
138 c rows = pwaves, columns = np
139 do np=1,npmax
140 do ilam=1,tlam
141 outfile_ps(np,ilam) = aphy_chl_ps(np,ilam)
142 enddo
143 enddo
144 IF (MASTER_CPU_THREAD(myThid)) THEN
145 CALL MDSFINDUNIT( IniUnit5, mythid )
146 open( IniUnit5,file='p-ini-char-apspec-psc.dat',
147 & status='unknown')
148 CALL MDSFINDUNIT( IniUnit6, mythid )
149 open( IniUnit6,file='p_ini_char_aspec_psc_nohead.dat',
150 & status='unknown')
151 write(IniUnit5,*)'Rows = pwaves. Columns = np'
152 write(IniUnit5,*)'pwaves found in pwaves-check.dat'
153 write(IniUnit5,*)'Is absoprtion by photosynthetic'
154 write(IniUnit5,*)'pigments only aphy_chl_ps (m-2 mg chla-1)'
155 do ilam=1,tlam
156 write(IniUnit5,130)(outfile_ps(np,ilam),np=1,npmax)
157 write(IniUnit6,130)(outfile_ps(np,ilam),np=1,npmax)
158 enddo
159 close(IniUnit5)
160 close(IniUnit6)
161 130 format(9999f10.4)
162 ENDIF
163
164
165 c file for wavebands used
166 IF (MASTER_CPU_THREAD(myThid)) THEN
167 c open(23,file='pwaves-check.dat',status='new')
168 CALL MDSFINDUNIT( IniUnit7, mythid )
169 open( IniUnit7,file='pwaves-check.dat',
170 & status='unknown')
171 write(IniUnit7,140)pwaves
172 close(IniUnit7)
173 140 format(i5)
174 ENDIF
175
176 #endif /* WAVEBANDS */
177
178 return
179 end

  ViewVC Help
Powered by ViewVC 1.1.22