Context Navigation

module_ForDiagnostics.F90 @ 772

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

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

Download in other formats:

Original Format