Context Navigation

write_histISCCP.h @ 4007

Last change on this file since 4007 was 1299, checked in by Laurent Fairhead, 15 years ago

Nettoyage general pour se rapprocher des normes et éviter des erreurs a la
compilation:

tous les FLOAT() sont remplacés par des REAL()
tous les STOP dans phylmd sont remplacés par des appels à abort_gcm
le common control défini dans le fichier control.h est remplacé par le module control_mod pour éviter des messages sur l'alignement des variables dans les déclarations
des $Header$ remplacés par des $Id$ pour svn

Quelques remplacements à faire ont pu m'échapper

General cleanup of the code to try and adhere to norms and to prevent some
compilation errors:

all FLOAT() instructions have been replaced by REAL() instructions
all STOP instructions in phylmd have been replaced by calls to abort_gcm
the common block control defined in the control.h file has been replaced by the control_mod to prevent compilation warnings on the alignement of declared variables
$Header$ replaced by $Id$ for svn

Some changes which should have been made might have escaped me

Property svn:eol-style set to native
Property svn:keywords set to Author Date Id Revision

File size: 7.7 KB

Rev	Line
[524]	1	!
[1299]	2	! $Id: write_histISCCP.h 1299 2010-01-20 14:27:21Z emillour $
[524]	3	!
	4	IF (ok_isccp) THEN
	5	c
[1038]	6	IF (MOD(itap,NINT(freq_ISCCP/dtime)).EQ.0) THEN
	7	c
[524]	8	ndex2d = 0
	9	ndex3d = 0
	10	c
	11	itau_w = itau_phy + itap
	12	c
[644]	13	IF(type_run.EQ."ENSP".OR.type_run.EQ."CLIM") THEN
	14	c
[684]	15	DO n=1, napisccp
	16	c
[524]	17	DO k=1,kmaxm1
[684]	18	zx_tmp_fi3d(1:klon, 1:lmaxm1)=fq_isccp(1:klon,k,1:lmaxm1,n)*100.
[766]	19	cym CALL gr_fi_ecrit(lmaxm1,klon,iim,jjmp1,zx_tmp_fi3d,
	20	cym . zx_tmp_3d)
[524]	21	c
	22	cIM: champ 3d : (lon,lat,pres) pour un tau fixe
	23	c
[878]	24	CALL histwrite_phy(nid_isccp,"cldISCCP_"//taulev(k)//verticaxe(n),
[766]	25	. itau_w,zx_tmp_fi3d)
[524]	26	ENDDO !k
	27	c
[766]	28	cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,nbsunlit(1,:,n),zx_tmp_2d)
[827]	29	CALL histwrite_phy(nid_isccp,"nsunlit"//verticaxe(n),itau_w,
[766]	30	. nbsunlit(1,:,n))
[524]	31	c
[1045]	32	CALL histwrite_phy(nid_isccp,"meantaucld"//verticaxe(n),itau_w,
	33	. meantaucld(:,n))
	34	c
[684]	35	ENDDO ! n=1, napisccp
[644]	36	ELSE IF(type_run.EQ."AMIP".OR.type_run.EQ."CFMI") THEN
	37	c
[684]	38	DO n=1, napisccp
	39	c print*,'n=',n,' write_ISCCP avant fq_isccp'
[644]	40	DO k=1, kmaxm1
	41	DO l=1, lmaxm1
	42	c
[684]	43	IF(top_height.LE.2) THEN
	44	DO i=1, klon
[1038]	45	c281008 beg
	46	c print*,'write_ISCCP i n nbsunlit',i,n,nbsunlit(1,i,n)
	47	c281008 end
	48	c
[684]	49	IF(nbsunlit(1,i,n).NE.0.) THEN
	50	fq_is_true(i,k,l,n)=
	51	$ fq_isccp(i,k,l,n)*100./nbsunlit(1,i,n)
	52	ELSE
	53	fq_is_true(i,k,l,n)=0
	54	ENDIF
	55	ENDDO
	56	ELSE IF(top_height.EQ.3) THEN
	57	DO i=1, klon
	58	fq_is_true(i,k,l,n) = fq_isccp(i,k,l,n)*100.
	59	ENDDO
	60	ENDIF
[766]	61	cym CALL gr_fi_ecrit(1,klon,iim,jjmp1,fq_is_true,
	62	cym . zx_tmp_2d)
[644]	63	c
	64	cIM: champ 2d : (lon,lat) pour un tau et une pc fixes
	65	c
[827]	66	CALL histwrite_phy(nid_isccp,pclev(l)//taulev(k)//verticaxe(n),
	67	. itau_w,fq_is_true(:,k,l,n))
[644]	68	ENDDO !l
	69	ENDDO !k
	70	c
[684]	71	c print*,'n=',n,' write_ISCCP avant nbsunlit'
[766]	72	cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,nbsunlit(1,:,n),zx_tmp_2d)
[827]	73	CALL histwrite_phy(nid_isccp,"nsunlit"//verticaxe(n),
[766]	74	. itau_w,nbsunlit(1,:,n))
[644]	75	c
[1045]	76	CALL histwrite_phy(nid_isccp,"meantaucld"//verticaxe(n),itau_w,
	77	. meantaucld(:,n))
	78	c
[1299]	79	zx_tmp_fi2d(1:klon)=REAL(seed(1:klon,n))
[684]	80	c
	81	c print*,'n=',n,' write_ISCCP avant seed'
[766]	82	cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
	83	CALL histwrite_phy(nid_isccp,"seed"//verticaxe(n),
	84	. itau_w,zx_tmp_fi2d)
[684]	85	c
	86	c 9types de nuages ISCCP-D2
	87	c fq_isccp(1:klon,k,l,n)*100. <=> pc_tau(k)_pclev(l)
	88	DO i=1, klon
	89	zx_tmp_fi2d(i)=
	90	$ (fq_is_true(i,1,1,n)+ fq_is_true(i,2,1,n)+ fq_is_true(i,3,1,n) +
	91	$ fq_is_true(i,1,2,n)+ fq_is_true(i,2,2,n)+ fq_is_true(i,3,2,n) +
	92	$ fq_is_true(i,1,3,n)+ fq_is_true(i,2,3,n)+ fq_is_true(i,3,3,n) )
	93	ENDDO
[766]	94	cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
	95	CALL histwrite_phy(nid_isccp,"cirr",itau_w,zx_tmp_fi2d)
[684]	96	c
	97	DO i=1, klon
	98	zx_tmp_fi2d(i)=
	99	$ (fq_is_true(i,4,1,n)+ fq_is_true(i,5,1,n) +
	100	$ fq_is_true(i,4,2,n)+ fq_is_true(i,5,2,n) +
	101	$ fq_is_true(i,4,3,n)+ fq_is_true(i,5,3,n) )
	102	ENDDO
[766]	103	cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
	104	CALL histwrite_phy(nid_isccp,"cist",itau_w,zx_tmp_fi2d)
[684]	105	c
	106	DO i=1, klon
	107	zx_tmp_fi2d(i)=
	108	$ (fq_is_true(i,6,1,n)+ fq_is_true(i,7,1,n) +
	109	$ fq_is_true(i,6,2,n)+ fq_is_true(i,7,2,n) +
	110	$ fq_is_true(i,6,3,n)+ fq_is_true(i,7,3,n) )
	111	ENDDO
[766]	112	cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
	113	CALL histwrite_phy(nid_isccp,"deep",itau_w,zx_tmp_fi2d)
[684]	114	c
	115	DO i=1, klon
	116	zx_tmp_fi2d(i)=
	117	$ (fq_is_true(i,1,4,n)+ fq_is_true(i,2,4,n)+ fq_is_true(i,3,4,n) +
	118	$ fq_is_true(i,1,5,n)+ fq_is_true(i,2,5,n)+ fq_is_true(i,3,5,n) )
	119	ENDDO
[766]	120	cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
	121	CALL histwrite_phy(nid_isccp,"alcu",itau_w,zx_tmp_fi2d)
[684]	122	c
	123	DO i=1, klon
	124	zx_tmp_fi2d(i)=
	125	$ (fq_is_true(i,4,4,n)+ fq_is_true(i,5,4,n) +
	126	$ fq_is_true(i,4,5,n)+ fq_is_true(i,5,5,n) )
	127	ENDDO
[766]	128	cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
	129	CALL histwrite_phy(nid_isccp,"alst",itau_w,zx_tmp_fi2d)
[684]	130	c
	131	DO i=1, klon
	132	zx_tmp_fi2d(i)=
	133	$ (fq_is_true(i,6,4,n)+ fq_is_true(i,7,4,n) +
	134	$ fq_is_true(i,6,5,n)+ fq_is_true(i,7,5,n) )
	135	ENDDO
[766]	136	cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
	137	CALL histwrite_phy(nid_isccp,"nist",itau_w,zx_tmp_fi2d)
[684]	138	c
	139	DO i=1, klon
	140	zx_tmp_fi2d(i)=
	141	$ (fq_is_true(i,1,6,n)+ fq_is_true(i,2,6,n)+ fq_is_true(i,3,6,n) +
	142	$ fq_is_true(i,1,7,n)+ fq_is_true(i,2,7,n)+ fq_is_true(i,3,7,n) )
	143	ENDDO
[766]	144	cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
	145	CALL histwrite_phy(nid_isccp,"cumu",itau_w,zx_tmp_fi2d)
[684]	146	c
	147	DO i=1, klon
	148	zx_tmp_fi2d(i)=
	149	$ (fq_is_true(i,4,6,n)+ fq_is_true(i,5,6,n) +
	150	$ fq_is_true(i,4,7,n)+ fq_is_true(i,5,7,n) )
	151	ENDDO
[766]	152	cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
	153	CALL histwrite_phy(nid_isccp,"stcu",itau_w,zx_tmp_fi2d)
[684]	154	c
	155	DO i=1, klon
	156	zx_tmp_fi2d(i)=
	157	$ (fq_is_true(i,6,6,n)+ fq_is_true(i,7,6,n) +
	158	$ fq_is_true(i,6,7,n)+ fq_is_true(i,7,7,n) )
	159	ENDDO
[766]	160	cym CALL gr_fi_ecrit(1, klon,iim,jjmp1,zx_tmp_fi2d,zx_tmp_2d)
	161	CALL histwrite_phy(nid_isccp,"stra",itau_w,zx_tmp_fi2d)
[684]	162	c
	163	c 3_tau_nuages x 3_levels
	164	c fq_is_true(1:klon,k,l,n)*100. <=> pc_tau(k)_pclev(l)
	165	DO i=1, klon
	166	cld_fi3d(i,1)=
	167	$ (fq_is_true(i,1,1,n)+ fq_is_true(i,2,1,n)+ fq_is_true(i,3,1,n) +
	168	$ fq_is_true(i,1,2,n)+ fq_is_true(i,2,2,n)+ fq_is_true(i,3,2,n) +
	169	$ fq_is_true(i,1,3,n)+ fq_is_true(i,2,3,n)+ fq_is_true(i,3,3,n) )
	170	cld_fi3d(i,2)=
	171	$ (fq_is_true(i,1,4,n)+ fq_is_true(i,2,4,n)+ fq_is_true(i,3,4,n) +
	172	$ fq_is_true(i,1,5,n)+ fq_is_true(i,2,5,n)+ fq_is_true(i,3,5,n) )
	173	cld_fi3d(i,3)=
	174	$ (fq_is_true(i,1,6,n)+ fq_is_true(i,2,6,n)+ fq_is_true(i,3,6,n) +
	175	$ fq_is_true(i,1,7,n)+ fq_is_true(i,2,7,n)+ fq_is_true(i,3,7,n) )
	176	ENDDO
[766]	177	cym CALL gr_fi_ecrit(lmax3,klon,iim,jjmp1,cld_fi3d,cld_3d)
	178	CALL histwrite_phy(nid_isccp,"thin",itau_w,cld_fi3d)
[684]	179	c
	180	DO i=1, klon
	181	cld_fi3d(i,1)=
	182	$ (fq_is_true(i,4,1,n)+ fq_is_true(i,5,1,n) +
	183	$ fq_is_true(i,4,2,n)+ fq_is_true(i,5,2,n) +
	184	$ fq_is_true(i,4,3,n)+ fq_is_true(i,5,3,n) )
	185	cld_fi3d(i,2)=
	186	$ (fq_is_true(i,4,4,n)+ fq_is_true(i,5,4,n) +
	187	$ fq_is_true(i,4,5,n)+ fq_is_true(i,5,5,n) )
	188	cld_fi3d(i,3)=
	189	$ (fq_is_true(i,4,6,n)+ fq_is_true(i,5,6,n) +
	190	$ fq_is_true(i,4,7,n)+ fq_is_true(i,5,7,n) )
	191	ENDDO
[766]	192	cym CALL gr_fi_ecrit(lmax3, klon,iim,jjmp1,cld_fi3d,cld_3d)
	193	CALL histwrite_phy(nid_isccp,"mid",itau_w,cld_fi3d)
[684]	194	c
	195	DO i=1, klon
	196	cld_fi3d(i,1)=
	197	$ (fq_is_true(i,6,1,n)+ fq_is_true(i,7,1,n) +
	198	$ fq_is_true(i,6,2,n)+ fq_is_true(i,7,2,n) +
	199	$ fq_is_true(i,6,3,n)+ fq_is_true(i,7,3,n) )
	200	cld_fi3d(i,2)=
	201	$ (fq_is_true(i,6,4,n)+ fq_is_true(i,7,4,n) +
	202	$ fq_is_true(i,6,5,n)+ fq_is_true(i,7,5,n) )
	203	cld_fi3d(i,3)=
	204	$ (fq_is_true(i,6,6,n)+ fq_is_true(i,7,6,n) +
	205	$ fq_is_true(i,6,7,n)+ fq_is_true(i,7,7,n) )
	206	ENDDO
[766]	207	cym CALL gr_fi_ecrit(lmax3, klon,iim,jjmp1,cld_fi3d,cld_3d)
	208	CALL histwrite_phy(nid_isccp,"thick",itau_w,cld_fi3d)
[684]	209	c
	210	ENDDO ! n=1, napisccp
	211	c
[644]	212	ENDIF
	213	c
[524]	214	if (ok_sync) then
[766]	215	c$OMP MASTER
[524]	216	call histsync(nid_isccp)
[766]	217	c$OMP END MASTER
[524]	218	endif
	219
[1038]	220	ENDIF !(MOD(itap,NINT(freq_ISCCP/dtime)).EQ.0) THEN
	221
[524]	222	ENDIF !ok_isccp

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/write_histISCCP.h @ 4007

Download in other formats: