Context Navigation

module_ForDiagnostics.f90 @ 1706

Last change on this file since 1706 was 1608, checked in by lfita, 8 years ago
Adding new Fortran capabilities after Rominas' DistriCorrection?
File size: 16.3 KB

Rev	Line
[770]	1	!! Fortran version of different diagnostics
	2	! L. Fita. LMD May 2016
[772]	3	! gfortran module_generic.o module_ForDiagnosticsVars.o -c module_ForDiagnostics.F90
	4	!
	5	! f2py -m module_ForDiagnostics --f90exec=/usr/bin/gfortran-4.7 -c module_generic.F90 module_ForDiagnosticsVars.F90 module_ForDiagnostics.F90
	6
[770]	7	MODULE module_ForDiagnostics
	8
[1608]	9	USE module_definitions
[770]	10	USE module_generic
[772]	11	USE module_ForDiagnosticsVars
[770]	12
[772]	13	CONTAINS
[770]	14
[772]	15	!!!!!!! Calculations
	16	! compute_cllmh4D3: Computation of low, medium and high cloudiness from a 4D CLDFRA and pressure being 3rd dimension the z-dim
	17	! compute_cllmh3D3: Computation of low, medium and high cloudiness from a 3D CLDFRA and pressure being 3rd dimension the z-dim
	18	! compute_cllmh: Computation of low, medium and high cloudiness
	19	! compute_clt4D3: Computation of total cloudiness from a 4D CLDFRA being 3rd dimension the z-dim
	20	! compute_clt3D3: Computation of total cloudiness from a 3D CLDFRA being 3rd dimension the z-dim
	21	! compute_clt: Computation of total cloudiness
[770]	22
[772]	23	!!!
	24	! Calculations
	25	!!!
[770]	26
[772]	27	SUBROUTINE compute_cllmh4D2(cldfra4D, pres4D, cllmh4D2, d1, d2, d3, d4)
	28	! Subroutine to compute the low, medium and high cloudiness following 'newmicro.F90' from LMDZ from a 4D CLDFRA and pressure
	29	! where zdim is the 2nd dimension (thus, cldfra4D(d1,d2,d3,d4) --> cllmh(3,d1,d3,d4) 1: low, 2: medium, 3: high
	30	! It should be properly done via an 'INTERFACE', but...
[770]	31
[772]	32	IMPLICIT NONE
	33
[1141]	34	INTEGER, INTENT(in) :: d1, d2, d3, d4
[772]	35	REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in) :: cldfra4D, pres4D
	36	REAL(r_k), DIMENSION(3,d1,d3,d4), INTENT(out) :: cllmh4D2
	37
	38	! Local
	39	INTEGER :: i,j,k, zdim, Ndim
	40
[770]	41	!!!!!!! Variables
[772]	42	! cldfra4D: 4D cloud fraction values [1]
	43	! pres4D: 4D pressure values [Pa]
	44	! Ndim: number of dimensions of the input data
	45	! d[1-4]: dimensions of 'cldfra4D'
	46	! zdim: number of the vertical-dimension within the matrix
	47	! cltlmh4D2: low, medium, high cloudiness for the 4D cldfra and d2 being 'zdim'
[770]	48
[772]	49	fname = 'compute_cllmh4D2'
	50	zdim = 2
	51	Ndim = 4
[770]	52
[772]	53	DO i=1, d1
	54	DO j=1, d3
	55	DO k=1, d4
	56	cllmh4D2(:,i,j,k) = var_cllmh(cldfra4D(i,:,j,k), pres4D(i,:,j,k), d2)
	57	END DO
	58	END DO
	59	END DO
	60
	61	RETURN
[770]	62
[772]	63	END SUBROUTINE compute_cllmh4D2
[770]	64
[772]	65	SUBROUTINE compute_cllmh3D1(cldfra3D, pres3D, cllmh3D1, d1, d2, d3)
	66	! Subroutine to compute the low, medium and high cloudiness following 'newmicro.F90' from LMDZ from a 3D CLDFRA and pressure
	67	! where zdim is the 1st dimension (thus, cldfra3D(d1,d2,d3) --> cllmh(3,d2,d3) 1: low, 2: medium, 3: high
	68	! It should be properly done via an 'INTERFACE', but...
[770]	69
[772]	70	IMPLICIT NONE
[770]	71
[1141]	72	INTEGER, INTENT(in) :: d1, d2, d3
[772]	73	REAL(r_k), DIMENSION(d1,d2,d3), INTENT(in) :: cldfra3D, pres3D
	74	REAL(r_k), DIMENSION(3,d2,d3), INTENT(out) :: cllmh3D1
	75
	76	! Local
	77	INTEGER :: i,j,k, zdim, Ndim
	78
	79	!!!!!!! Variables
	80	! cldfra3D: 3D cloud fraction values [1]
	81	! pres3D: 3D pressure values [Pa]
	82	! Ndim: number of dimensions of the input data
	83	! d[1-3]: dimensions of 'cldfra3D'
	84	! zdim: number of the vertical-dimension within the matrix
	85	! cltlmh3D1: low, medium, high cloudiness for the 3D cldfra and d1 being 'zdim'
	86
	87	fname = 'compute_cllmh3D1'
	88	zdim = 1
	89	Ndim = 3
	90
	91	DO i=1, d1
	92	DO j=1, d2
	93	cllmh3D1(:,i,j) = var_cllmh(cldfra3D(:,i,j), pres3D(:,i,j), d1)
	94	END DO
	95	END DO
	96
	97	RETURN
	98
	99	END SUBROUTINE compute_cllmh3D1
	100
	101	SUBROUTINE compute_cllmh(cldfra1D, cldfra2D, cldfra3D, cldfra4D, pres1D, pres2D, pres3D, pres4D, &
	102	Ndim, zdim, cllmh1D, cllmh2D1, cllmh2D2, cllmh3D1, cllmh3D2, cllmh3D3, cllmh4D1, cllmh4D2, &
	103	cllmh4D3, cllmh4D4, d1, d2, d3, d4)
	104	! Subroutine to compute the low, medium and high cloudiness following 'newmicro.F90' from LMDZ
	105
[770]	106	IMPLICIT NONE
	107
[1141]	108	INTEGER, INTENT(in) :: Ndim, d1, d2, d3, d4, zdim
[772]	109	REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(in) :: cldfra1D, pres1D
	110	REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(in) :: cldfra2D, pres2D
	111	REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL, INTENT(in) :: cldfra3D, pres3D
	112	REAL(r_k), DIMENSION(d1,d2,d3,d4), OPTIONAL, &
	113	INTENT(in) :: cldfra4D, pres4D
	114	REAL(r_k), DIMENSION(3), OPTIONAL, INTENT(out) :: cllmh1D
	115	REAL(r_k), DIMENSION(d1,3), OPTIONAL, INTENT(out) :: cllmh2D1
	116	REAL(r_k), DIMENSION(d2,3), OPTIONAL, INTENT(out) :: cllmh2D2
	117	REAL(r_k), DIMENSION(d2,d3,3), OPTIONAL, INTENT(out) :: cllmh3D1
	118	REAL(r_k), DIMENSION(d1,d3,3), OPTIONAL, INTENT(out) :: cllmh3D2
	119	REAL(r_k), DIMENSION(d1,d2,3), OPTIONAL, INTENT(out) :: cllmh3D3
	120	REAL(r_k), DIMENSION(d2,d3,d4,3), OPTIONAL, &
	121	INTENT(out) :: cllmh4D1
	122	REAL(r_k), DIMENSION(d1,d3,d4,3), OPTIONAL, &
	123	INTENT(out) :: cllmh4D2
	124	REAL(r_k), DIMENSION(d1,d2,d4,3), OPTIONAL, &
	125	INTENT(out) :: cllmh4D3
	126	REAL(r_k), DIMENSION(d1,d2,d3,3), OPTIONAL, &
	127	INTENT(out) :: cllmh4D4
[770]	128
	129	! Local
[772]	130	INTEGER :: i,j,k
[770]	131
	132	!!!!!!! Variables
[772]	133	! cldfra[1-4]D: cloud fraction values [1]
	134	! pres[1-4]D: pressure values [Pa]
	135	! Ndim: number of dimensions of the input data
	136	! d[1-4]: dimensions of 'cldfra'
	137	! zdim: number of the vertical-dimension within the matrix
	138	! cllmh1D: low, medium and high cloudiness for the 1D cldfra
	139	! cllmh2D1: low, medium and high cloudiness for the 2D cldfra and d1 being 'zdim'
	140	! cllmh2D2: low, medium and high cloudiness for the 2D cldfra and d2 being 'zdim'
	141	! cllmh3D1: low, medium and high cloudiness for the 3D cldfra and d1 being 'zdim'
	142	! cllmh3D2: low, medium and high cloudiness for the 3D cldfra and d2 being 'zdim'
	143	! cllmh3D3: low, medium and high cloudiness for the 3D cldfra and d3 being 'zdim'
	144	! cllmh4D1: low, medium and high cloudiness for the 4D cldfra and d1 being 'zdim'
	145	! cllmh4D2: low, medium and high cloudiness for the 4D cldfra and d2 being 'zdim'
	146	! cllmh4D3: low, medium and high cloudiness for the 4D cldfra and d3 being 'zdim'
	147	! cllmh4D4: low, medium and high cloudiness for the 4D cldfra and d4 being 'zdim'
[770]	148
[772]	149	fname = 'compute_cllmh'
[770]	150
[772]	151	SELECT CASE (Ndim)
	152	CASE (1)
	153	cllmh1D = var_cllmh(cldfra1D, pres1D, d1)
	154	CASE (2)
	155	IF (zdim == 1) THEN
	156	DO i=1, d2
	157	cllmh2D1(i,:) = var_cllmh(cldfra2D(:,i), pres2D(:,i), d1)
	158	END DO
	159	ELSE IF (zdim == 2) THEN
	160	DO i=1, d1
	161	cllmh2D2(i,:) = var_cllmh(cldfra2D(:,i), pres2D(i,:), d2)
	162	END DO
	163	ELSE
	164	PRINT *,TRIM(ErrWarnMsg('err'))
	165	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
	166	PRINT *,' accepted values: 1,2'
	167	STOP
	168	END IF
	169	CASE (3)
	170	IF (zdim == 1) THEN
	171	DO i=1, d2
	172	DO j=1, d3
	173	cllmh3D1(i,j,:) = var_cllmh(cldfra3D(:,i,j), pres3D(:,i,j), d1)
	174	END DO
	175	END DO
	176	ELSE IF (zdim == 2) THEN
	177	DO i=1, d1
	178	DO j=1, d3
	179	cllmh3D2(i,j,:) = var_cllmh(cldfra3D(i,:,j), pres3D(i,:,j), d2)
	180	END DO
	181	END DO
	182	ELSE IF (zdim == 3) THEN
	183	DO i=1, d1
	184	DO j=1, d2
	185	cllmh3D3(i,j,:) = var_cllmh(cldfra3D(i,j,:), pres3D(i,j,:), d3)
	186	END DO
	187	END DO
	188	ELSE
	189	PRINT *,TRIM(ErrWarnMsg('err'))
	190	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
	191	PRINT *,' accepted values: 1,2,3'
	192	STOP
	193	END IF
	194	CASE (4)
	195	IF (zdim == 1) THEN
	196	DO i=1, d2
	197	DO j=1, d3
	198	DO k=1, d4
	199	cllmh4D1(i,j,k,:) = var_cllmh(cldfra4D(:,i,j,k), pres4D(:,i,j,k), d1)
	200	END DO
	201	END DO
	202	END DO
	203	ELSE IF (zdim == 2) THEN
	204	DO i=1, d1
	205	DO j=1, d3
	206	DO k=1, d4
	207	cllmh4D2(i,j,k,:) = var_cllmh(cldfra4D(i,:,j,k), pres4D(i,:,j,k), d2)
	208	END DO
	209	END DO
	210	END DO
	211	ELSE IF (zdim == 3) THEN
	212	DO i=1, d2
	213	DO j=1, d3
	214	DO k=1, d4
	215	cllmh4D3(i,j,k,:) = var_cllmh(cldfra4D(i,j,:,k), pres4D(i,j,:,k), d3)
	216	END DO
	217	END DO
	218	END DO
	219	ELSE IF (zdim == 4) THEN
	220	DO i=1, d1
	221	DO j=1, d2
	222	DO k=1, d3
	223	cllmh4D4(i,j,k,:) = var_cllmh(cldfra4D(i,j,k,:), pres4D(i,j,k,:), d4)
	224	END DO
	225	END DO
	226	END DO
	227	ELSE
	228	PRINT *,TRIM(ErrWarnMsg('err'))
	229	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
	230	PRINT *,' accepted values: 1,2,3,4'
	231	STOP
	232	END IF
	233	CASE DEFAULT
	234	PRINT *,TRIM(ErrWarnMsg('err'))
	235	PRINT *,' ' // TRIM(fname) // ': Ndim:', Ndim,' not ready !!'
	236	STOP
	237	END SELECT
[770]	238
	239	RETURN
	240
[772]	241	END SUBROUTINE compute_cllmh
[770]	242
[772]	243	SUBROUTINE compute_clt4D2(cldfra4D, clt4D2, d1, d2, d3, d4)
	244	! Subroutine to compute the total cloudiness following 'newmicro.F90' from LMDZ from a 4D CLDFRA
	245	! where zdim is the 2nd dimension (thus, cldfra4D(d1,d2,d3,d4) --> clt(d1,d3,d4)
	246	! It should be properly done via an 'INTERFACE', but...
[770]	247
	248	IMPLICIT NONE
	249
[1141]	250	INTEGER, INTENT(in) :: d1, d2, d3, d4
[772]	251	REAL(r_k), DIMENSION(d1,d2,d3,d4), INTENT(in) :: cldfra4D
	252	REAL(r_k), DIMENSION(d1,d3,d4), INTENT(out) :: clt4D2
	253
[770]	254	! Local
[772]	255	INTEGER :: i,j,k, zdim, Ndim
	256
[770]	257	!!!!!!! Variables
[772]	258	! cldfra4D: 4D cloud fraction values [1]
	259	! Ndim: number of dimensions of the input data
	260	! d[1-4]: dimensions of 'cldfra4D'
	261	! zdim: number of the vertical-dimension within the matrix
	262	! clt4D2: total cloudiness for the 4D cldfra and d2 being 'zdim'
[770]	263
[772]	264	fname = 'compute_clt4D2'
	265	zdim = 2
	266	Ndim = 4
[770]	267
[772]	268	DO i=1, d1
	269	DO j=1, d3
	270	DO k=1, d4
	271	clt4D2(i,j,k) = var_clt(cldfra4D(i,:,j,k), d2)
	272	END DO
	273	END DO
[770]	274	END DO
[772]	275
	276	RETURN
[770]	277
[772]	278	END SUBROUTINE compute_clt4D2
[770]	279
[772]	280	SUBROUTINE compute_clt3D1(cldfra3D, clt3D1, d1, d2, d3)
	281	! Subroutine to compute the total cloudiness following 'newmicro.F90' from LMDZ from a 3D CLDFRA
	282	! where zdim is the 1st dimension (thus, cldfra4D(d1,d2,d3) --> clt(d2,d3)
	283	! It should be properly done via an 'INTERFACE', but...
[770]	284
[772]	285	IMPLICIT NONE
[770]	286
[1141]	287	INTEGER, INTENT(in) :: d1, d2, d3
[772]	288	REAL(r_k), DIMENSION(d1,d2,d3), INTENT(in) :: cldfra3D
	289	REAL(r_k), DIMENSION(d2,d3), INTENT(out) :: clt3D1
[770]	290
[772]	291	! Local
	292	INTEGER :: i,j,k, zdim, Ndim
	293
	294	!!!!!!! Variables
	295	! cldfra3D: 3D cloud fraction values [1]
	296	! Ndim: number of dimensions of the input data
	297	! d[1-3]: dimensions of 'cldfra3D'
	298	! zdim: number of the vertical-dimension within the matrix
	299	! clt3D1: total cloudiness for the 3D cldfra and d1 being 'zdim'
	300
	301	fname = 'compute_clt3D1'
	302	zdim = 1
	303	Ndim = 3
	304
	305	DO i=1, d2
	306	DO j=1, d3
	307	clt3D1(i,j) = var_clt(cldfra3D(:,i,j), d1)
	308	END DO
	309	END DO
	310
	311	RETURN
	312
	313	END SUBROUTINE compute_clt3D1
	314
	315	SUBROUTINE compute_clt(cldfra1D, cldfra2D, cldfra3D, cldfra4D, Ndim, zdim, clt1D, clt2D1, clt2D2, &
	316	clt3D1, clt3D2, clt3D3, clt4D1, clt4D2, clt4D3, clt4D4, d1, d2, d3, d4)
	317	! Subroutine to compute the total cloudiness following 'newmicro.F90' from LMDZ
	318
[770]	319	IMPLICIT NONE
	320
[1141]	321	INTEGER, INTENT(in) :: Ndim, d1, d2, d3, d4, zdim
[770]	322	REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(in) :: cldfra1D
	323	REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(in) :: cldfra2D
	324	REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL, INTENT(in) :: cldfra3D
	325	REAL(r_k), DIMENSION(d1,d2,d3,d4), OPTIONAL, &
	326	INTENT(in) :: cldfra4D
	327	REAL(r_k), OPTIONAL, INTENT(out) :: clt1D
	328	REAL(r_k), DIMENSION(d1), OPTIONAL, INTENT(out) :: clt2D1
	329	REAL(r_k), DIMENSION(d2), OPTIONAL, INTENT(out) :: clt2D2
	330	REAL(r_k), DIMENSION(d2,d3), OPTIONAL, INTENT(out) :: clt3D1
	331	REAL(r_k), DIMENSION(d1,d3), OPTIONAL, INTENT(out) :: clt3D2
	332	REAL(r_k), DIMENSION(d1,d2), OPTIONAL, INTENT(out) :: clt3D3
	333	REAL(r_k), DIMENSION(d2,d3,d4), OPTIONAL,INTENT(out) :: clt4D1
	334	REAL(r_k), DIMENSION(d1,d3,d4), OPTIONAL,INTENT(out) :: clt4D2
	335	REAL(r_k), DIMENSION(d1,d2,d4), OPTIONAL,INTENT(out) :: clt4D3
	336	REAL(r_k), DIMENSION(d1,d2,d3), OPTIONAL,INTENT(out) :: clt4D4
	337
	338	! Local
	339	INTEGER :: i,j,k
	340
	341	!!!!!!! Variables
	342	! cldfra[1-4]D: cloud fraction values [1]
	343	! Ndim: number of dimensions of the input data
	344	! d[1-4]: dimensions of 'cldfra'
	345	! zdim: number of the vertical-dimension within the matrix
	346	! clt1D: total cloudiness for the 1D cldfra
	347	! clt2D1: total cloudiness for the 2D cldfra and d1 being 'zdim'
	348	! clt2D2: total cloudiness for the 2D cldfra and d2 being 'zdim'
	349	! clt3D1: total cloudiness for the 3D cldfra and d1 being 'zdim'
	350	! clt3D2: total cloudiness for the 3D cldfra and d2 being 'zdim'
	351	! clt3D3: total cloudiness for the 3D cldfra and d3 being 'zdim'
	352	! clt4D1: total cloudiness for the 4D cldfra and d1 being 'zdim'
	353	! clt4D2: total cloudiness for the 4D cldfra and d2 being 'zdim'
	354	! clt4D3: total cloudiness for the 4D cldfra and d3 being 'zdim'
	355	! clt4D4: total cloudiness for the 4D cldfra and d4 being 'zdim'
	356
	357	fname = 'compute_clt'
	358
	359	SELECT CASE (Ndim)
	360	CASE (1)
	361	clt1D = var_clt(cldfra1D, d1)
	362	CASE (2)
	363	IF (zdim == 1) THEN
	364	DO i=1, d2
	365	clt2D1(i) = var_clt(cldfra2D(:,i), d1)
	366	END DO
	367	ELSE IF (zdim == 2) THEN
	368	DO i=1, d1
	369	clt2D2(i) = var_clt(cldfra2D(:,i), d2)
	370	END DO
	371	ELSE
	372	PRINT *,TRIM(ErrWarnMsg('err'))
	373	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
	374	PRINT *,' accepted values: 1,2'
	375	STOP
	376	END IF
	377	CASE (3)
	378	IF (zdim == 1) THEN
	379	DO i=1, d2
	380	DO j=1, d3
	381	clt3D1(i,j) = var_clt(cldfra3D(:,i,j), d1)
	382	END DO
	383	END DO
	384	ELSE IF (zdim == 2) THEN
	385	DO i=1, d1
	386	DO j=1, d3
	387	clt3D2(i,j) = var_clt(cldfra3D(i,:,j), d2)
	388	END DO
	389	END DO
	390	ELSE IF (zdim == 3) THEN
	391	DO i=1, d1
	392	DO j=1, d2
	393	clt3D3(i,j) = var_clt(cldfra3D(i,j,:), d3)
	394	END DO
	395	END DO
	396	ELSE
	397	PRINT *,TRIM(ErrWarnMsg('err'))
	398	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
	399	PRINT *,' accepted values: 1,2,3'
	400	STOP
	401	END IF
	402	CASE (4)
	403	IF (zdim == 1) THEN
	404	DO i=1, d2
	405	DO j=1, d3
	406	DO k=1, d4
	407	clt4D1(i,j,k) = var_clt(cldfra4D(:,i,j,k), d1)
	408	END DO
	409	END DO
	410	END DO
	411	ELSE IF (zdim == 2) THEN
	412	DO i=1, d1
	413	DO j=1, d3
	414	DO k=1, d4
	415	clt4D2(i,j,k) = var_clt(cldfra4D(i,:,j,k), d2)
	416	END DO
	417	END DO
	418	END DO
	419	ELSE IF (zdim == 3) THEN
	420	DO i=1, d2
	421	DO j=1, d3
	422	DO k=1, d4
	423	clt4D3(i,j,k) = var_clt(cldfra4D(i,j,:,k), d3)
	424	END DO
	425	END DO
	426	END DO
	427	ELSE IF (zdim == 4) THEN
	428	DO i=1, d1
	429	DO j=1, d2
	430	DO k=1, d3
	431	clt4D4(i,j,k) = var_clt(cldfra4D(i,j,k,:), d4)
	432	END DO
	433	END DO
	434	END DO
	435	ELSE
	436	PRINT *,TRIM(ErrWarnMsg('err'))
	437	PRINT *,' ' // TRIM(fname) // ': wrong zdim:', zdim,' for Ndim=', Ndim, ' !!'
	438	PRINT *,' accepted values: 1,2,3,4'
	439	STOP
	440	END IF
	441	CASE DEFAULT
	442	PRINT *,TRIM(ErrWarnMsg('err'))
	443	PRINT *,' ' // TRIM(fname) // ': Ndim:', Ndim,' not ready !!'
	444	STOP
	445	END SELECT
	446
	447	RETURN
	448
	449	END SUBROUTINE compute_clt
	450
	451	END MODULE module_ForDiagnostics

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

Download in other formats:

Original Format