Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

f_pack.F90 @ 2759

Last change on this file since 2759 was 2759, checked in by aslmd, 2 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 21.8 KB

Rev	Line
[2759]	1	MODULE duplicate_of_driver_constants
	2	! These definitions must be the same as frame/module_driver_constants
	3	! and also the same as the definitions in rsl_lite.h
	4	INTEGER , PARAMETER :: DATA_ORDER_XYZ = 1
	5	INTEGER , PARAMETER :: DATA_ORDER_YXZ = 2
	6	INTEGER , PARAMETER :: DATA_ORDER_ZXY = 3
	7	INTEGER , PARAMETER :: DATA_ORDER_ZYX = 4
	8	INTEGER , PARAMETER :: DATA_ORDER_XZY = 5
	9	INTEGER , PARAMETER :: DATA_ORDER_YZX = 6
	10	END MODULE duplicate_of_driver_constants
	11
	12	SUBROUTINE f_pack_int ( inbuf, outbuf, memorder, js, je, ks, ke, &
	13	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	14	USE duplicate_of_driver_constants
	15	IMPLICIT NONE
	16	INTEGER, INTENT(IN) :: memorder
	17	INTEGER ims, ime, jms, jme, kms, kme
	18	INTEGER inbuf(), outbuf()
	19	INTEGER js, je, ks, ke, is, ie, curs
	20	SELECT CASE ( memorder )
	21	CASE ( DATA_ORDER_XYZ )
	22	CALL f_pack_int_ijk( inbuf, outbuf, js, je, ks, ke, is, ie, &
	23	& jms, jme, kms, kme, ims, ime, curs )
	24	CASE ( DATA_ORDER_YXZ )
	25	CALL f_pack_int_jik( inbuf, outbuf, js, je, ks, ke, is, ie, &
	26	& jms, jme, kms, kme, ims, ime, curs )
	27	CASE ( DATA_ORDER_XZY )
	28	CALL f_pack_int_ikj( inbuf, outbuf, js, je, ks, ke, is, ie, &
	29	& jms, jme, kms, kme, ims, ime, curs )
	30	CASE ( DATA_ORDER_YZX )
	31	CALL f_pack_int_jki( inbuf, outbuf, js, je, ks, ke, is, ie, &
	32	& jms, jme, kms, kme, ims, ime, curs )
	33	CASE ( DATA_ORDER_ZXY )
	34	CALL f_pack_int_kij( inbuf, outbuf, js, je, ks, ke, is, ie, &
	35	& jms, jme, kms, kme, ims, ime, curs )
	36	CASE ( DATA_ORDER_ZYX )
	37	CALL f_pack_int_kji( inbuf, outbuf, js, je, ks, ke, is, ie, &
	38	& jms, jme, kms, kme, ims, ime, curs )
	39	END SELECT
	40	RETURN
	41	END SUBROUTINE f_pack_int
	42
	43	SUBROUTINE f_pack_lint ( inbuf, outbuf, memorder, js, je, ks, ke, &
	44	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	45	USE duplicate_of_driver_constants
	46	IMPLICIT NONE
	47	INTEGER, INTENT(IN) :: memorder
	48	INTEGER jms, jme, kms, kme, ims, ime
	49	INTEGER8 inbuf(), outbuf(*)
	50	INTEGER js, je, ks, ke, is, ie, curs
	51	SELECT CASE ( memorder )
	52	CASE ( DATA_ORDER_XYZ )
	53	CALL f_pack_lint_ijk( inbuf, outbuf, js, je, ks, ke, is, ie, &
	54	& jms, jme, kms, kme, ims, ime, curs )
	55	CASE ( DATA_ORDER_YXZ )
	56	CALL f_pack_lint_jik( inbuf, outbuf, js, je, ks, ke, is, ie, &
	57	& jms, jme, kms, kme, ims, ime, curs )
	58	CASE ( DATA_ORDER_XZY )
	59	CALL f_pack_lint_ikj( inbuf, outbuf, js, je, ks, ke, is, ie, &
	60	& jms, jme, kms, kme, ims, ime, curs )
	61	CASE ( DATA_ORDER_YZX )
	62	CALL f_pack_lint_jki( inbuf, outbuf, js, je, ks, ke, is, ie, &
	63	& jms, jme, kms, kme, ims, ime, curs )
	64	CASE ( DATA_ORDER_ZXY )
	65	CALL f_pack_lint_kij( inbuf, outbuf, js, je, ks, ke, is, ie, &
	66	& jms, jme, kms, kme, ims, ime, curs )
	67	CASE ( DATA_ORDER_ZYX )
	68	CALL f_pack_lint_kji( inbuf, outbuf, js, je, ks, ke, is, ie, &
	69	& jms, jme, kms, kme, ims, ime, curs )
	70	END SELECT
	71	RETURN
	72	END SUBROUTINE f_pack_lint
	73
	74	SUBROUTINE f_unpack_int ( inbuf, outbuf, memorder, js, je, ks, ke, &
	75	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	76	USE duplicate_of_driver_constants
	77	IMPLICIT NONE
	78	INTEGER, INTENT(IN) :: memorder
	79	INTEGER jms, jme, kms, kme, ims, ime
	80	INTEGER outbuf(), inbuf()
	81	INTEGER js, je, ks, ke, is, ie, curs
	82	SELECT CASE ( memorder )
	83	CASE ( DATA_ORDER_XYZ )
	84	CALL f_unpack_int_ijk( inbuf, outbuf, js, je, ks, ke, &
	85	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	86	CASE ( DATA_ORDER_YXZ )
	87	CALL f_unpack_int_jik( inbuf, outbuf, js, je, ks, ke, &
	88	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	89	CASE ( DATA_ORDER_XZY )
	90	CALL f_unpack_int_ikj( inbuf, outbuf, js, je, ks, ke, &
	91	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	92	CASE ( DATA_ORDER_YZX )
	93	CALL f_unpack_int_jki( inbuf, outbuf, js, je, ks, ke, &
	94	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	95	CASE ( DATA_ORDER_ZXY )
	96	CALL f_unpack_int_kij( inbuf, outbuf, js, je, ks, ke, &
	97	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	98	CASE ( DATA_ORDER_ZYX )
	99	CALL f_unpack_int_kji( inbuf, outbuf, js, je, ks, ke, &
	100	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	101	END SELECT
	102	RETURN
	103	END SUBROUTINE f_unpack_int
	104
	105	SUBROUTINE f_unpack_lint ( inbuf, outbuf, memorder, js, je, ks, &
	106	& ke, is, ie, jms, jme, kms, kme, ims, ime, curs )
	107	USE duplicate_of_driver_constants
	108	IMPLICIT NONE
	109	INTEGER, INTENT(IN) :: memorder
	110	INTEGER jms, jme, kms, kme, ims, ime
	111	INTEGER8 outbuf(), inbuf(*)
	112	INTEGER js, je, ks, ke, is, ie, curs
	113	SELECT CASE ( memorder )
	114	CASE ( DATA_ORDER_XYZ )
	115	CALL f_unpack_lint_ijk( inbuf, outbuf, js, je, ks, ke, &
	116	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	117	CASE ( DATA_ORDER_YXZ )
	118	CALL f_unpack_lint_jik( inbuf, outbuf, js, je, ks, ke, &
	119	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	120	CASE ( DATA_ORDER_XZY )
	121	CALL f_unpack_lint_ikj( inbuf, outbuf, js, je, ks, ke, &
	122	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	123	CASE ( DATA_ORDER_YZX )
	124	CALL f_unpack_lint_jki( inbuf, outbuf, js, je, ks, ke, &
	125	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	126	CASE ( DATA_ORDER_ZXY )
	127	CALL f_unpack_lint_kij( inbuf, outbuf, js, je, ks, ke, &
	128	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	129	CASE ( DATA_ORDER_ZYX )
	130	CALL f_unpack_lint_kji( inbuf, outbuf, js, je, ks, ke, &
	131	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	132	END SELECT
	133	RETURN
	134	END SUBROUTINE f_unpack_lint
	135
	136	!ikj
	137	SUBROUTINE f_pack_int_ikj ( inbuf, outbuf, js, je, ks, ke, &
	138	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	139	IMPLICIT NONE
	140	INTEGER jms, jme, kms, kme, ims, ime
	141	INTEGER inbuf(ims:ime,kms:kme,jms:jme), outbuf(*)
	142	INTEGER js, je, ks, ke, is, ie, curs
	143	! Local
	144	INTEGER i,j,k,p
	145	p = 1
	146	DO j = js, je
	147	DO k = ks, ke
	148	DO i = is, ie
	149	outbuf(p) = inbuf(i,k,j)
	150	p = p + 1
	151	ENDDO
	152	ENDDO
	153	ENDDO
	154	curs = p - 1
	155	RETURN
	156	END SUBROUTINE f_pack_int_ikj
	157
	158	SUBROUTINE f_pack_lint_ikj ( inbuf, outbuf, js, je, ks, ke, &
	159	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	160	IMPLICIT NONE
	161	INTEGER jms, jme, kms, kme, ims, ime
	162	INTEGER8 inbuf(ims:ime,kms:kme,jms:jme), outbuf()
	163	INTEGER js, je, ks, ke, is, ie, curs
	164	! Local
	165	INTEGER i,j,k,p
	166	p = 1
	167	DO j = js, je
	168	DO k = ks, ke
	169	DO i = is, ie
	170	outbuf(p) = inbuf(i,k,j)
	171	p = p + 1
	172	ENDDO
	173	ENDDO
	174	ENDDO
	175	curs = p - 1
	176	RETURN
	177	END SUBROUTINE f_pack_lint_ikj
	178
	179	SUBROUTINE f_unpack_int_ikj ( inbuf, outbuf, js, je, ks, ke, &
	180	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	181	IMPLICIT NONE
	182	INTEGER jms, jme, kms, kme, ims, ime
	183	INTEGER outbuf(ims:ime,kms:kme,jms:jme), inbuf(*)
	184	INTEGER js, je, ks, ke, is, ie, curs
	185	! Local
	186	INTEGER i,j,k,p
	187	p = 1
	188	DO j = js, je
	189	DO k = ks, ke
	190	DO i = is, ie
	191	outbuf(i,k,j) = inbuf(p)
	192	p = p + 1
	193	ENDDO
	194	ENDDO
	195	ENDDO
	196	curs = p - 1
	197	RETURN
	198	END SUBROUTINE f_unpack_int_ikj
	199
	200	SUBROUTINE f_unpack_lint_ikj ( inbuf, outbuf, js, je, ks, ke, &
	201	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	202	IMPLICIT NONE
	203	INTEGER jms, jme, kms, kme, ims, ime
	204	INTEGER8 outbuf(ims:ime,kms:kme,jms:jme), inbuf()
	205	INTEGER js, je, ks, ke, is, ie, curs
	206	! Local
	207	INTEGER i,j,k,p
	208	p = 1
	209	DO j = js, je
	210	DO k = ks, ke
	211	DO i = is, ie
	212	outbuf(i,k,j) = inbuf(p)
	213	p = p + 1
	214	ENDDO
	215	ENDDO
	216	ENDDO
	217	curs = p - 1
	218	RETURN
	219	END SUBROUTINE f_unpack_lint_ikj
	220
	221	!jki
	222	SUBROUTINE f_pack_int_jki ( inbuf, outbuf, js, je, ks, ke, &
	223	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	224	IMPLICIT NONE
	225	INTEGER jms, jme, kms, kme, ims, ime
	226	INTEGER inbuf(jms:jme,kms:kme,ims:ime), outbuf(*)
	227	INTEGER js, je, ks, ke, is, ie, curs
	228	! Local
	229	INTEGER i,j,k,p
	230	p = 1
	231	DO i = is, ie
	232	DO k = ks, ke
	233	DO j = js, je
	234	outbuf(p) = inbuf(j,k,i)
	235	p = p + 1
	236	ENDDO
	237	ENDDO
	238	ENDDO
	239	curs = p - 1
	240	RETURN
	241	END SUBROUTINE f_pack_int_jki
	242
	243	SUBROUTINE f_pack_lint_jki ( inbuf, outbuf, js, je, ks, ke, &
	244	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	245	IMPLICIT NONE
	246	INTEGER jms, jme, kms, kme, ims, ime
	247	INTEGER8 inbuf(jms:jme,kms:kme,ims:ime), outbuf()
	248	INTEGER js, je, ks, ke, is, ie, curs
	249	! Local
	250	INTEGER i,j,k,p
	251	p = 1
	252	DO i = is, ie
	253	DO k = ks, ke
	254	DO j = js, je
	255	outbuf(p) = inbuf(j,k,i)
	256	p = p + 1
	257	ENDDO
	258	ENDDO
	259	ENDDO
	260	curs = p - 1
	261	RETURN
	262	END SUBROUTINE f_pack_lint_jki
	263
	264	SUBROUTINE f_unpack_int_jki ( inbuf, outbuf, js, je, ks, ke, &
	265	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	266	IMPLICIT NONE
	267	INTEGER jms, jme, kms, kme, ims, ime
	268	INTEGER outbuf(jms:jme,kms:kme,ims:ime), inbuf(*)
	269	INTEGER js, je, ks, ke, is, ie, curs
	270	! Local
	271	INTEGER i,j,k,p
	272	p = 1
	273	DO i = is, ie
	274	DO k = ks, ke
	275	DO j = js, je
	276	outbuf(j,k,i) = inbuf(p)
	277	p = p + 1
	278	ENDDO
	279	ENDDO
	280	ENDDO
	281	curs = p - 1
	282	RETURN
	283	END SUBROUTINE f_unpack_int_jki
	284
	285	SUBROUTINE f_unpack_lint_jki ( inbuf, outbuf, js, je, ks, ke, &
	286	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	287	IMPLICIT NONE
	288	INTEGER jms, jme, kms, kme, ims, ime
	289	INTEGER8 outbuf(jms:jme,kms:kme,ims:ime), inbuf()
	290	INTEGER js, je, ks, ke, is, ie, curs
	291	! Local
	292	INTEGER i,j,k,p
	293	p = 1
	294	DO i = is, ie
	295	DO k = ks, ke
	296	DO j = js, je
	297	outbuf(j,k,i) = inbuf(p)
	298	p = p + 1
	299	ENDDO
	300	ENDDO
	301	ENDDO
	302	curs = p - 1
	303	RETURN
	304	END SUBROUTINE f_unpack_lint_jki
	305
	306	!ijk
	307	SUBROUTINE f_pack_int_ijk ( inbuf, outbuf, js, je, ks, ke, &
	308	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	309	IMPLICIT NONE
	310	INTEGER jms, jme, kms, kme, ims, ime
	311	INTEGER inbuf(ims:ime,jms:jme,kms:kme), outbuf(*)
	312	INTEGER js, je, ks, ke, is, ie, curs
	313	! Local
	314	INTEGER i,j,k,p
	315	p = 1
	316	DO k = ks, ke
	317	DO j = js, je
	318	DO i = is, ie
	319	outbuf(p) = inbuf(i,j,k)
	320	p = p + 1
	321	ENDDO
	322	ENDDO
	323	ENDDO
	324	curs = p - 1
	325	RETURN
	326	END SUBROUTINE f_pack_int_ijk
	327
	328	SUBROUTINE f_pack_lint_ijk ( inbuf, outbuf, js, je, ks, ke, &
	329	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	330	IMPLICIT NONE
	331	INTEGER jms, jme, kms, kme, ims, ime
	332	INTEGER8 inbuf(ims:ime,jms:jme,kms:kme), outbuf()
	333	INTEGER js, je, ks, ke, is, ie, curs
	334	! Local
	335	INTEGER i,j,k,p
	336	p = 1
	337	DO k = ks, ke
	338	DO j = js, je
	339	DO i = is, ie
	340	outbuf(p) = inbuf(i,j,k)
	341	p = p + 1
	342	ENDDO
	343	ENDDO
	344	ENDDO
	345	curs = p - 1
	346	RETURN
	347	END SUBROUTINE f_pack_lint_ijk
	348
	349	SUBROUTINE f_unpack_int_ijk ( inbuf, outbuf, js, je, ks, ke, &
	350	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	351	IMPLICIT NONE
	352	INTEGER jms, jme, kms, kme, ims, ime
	353	INTEGER outbuf(ims:ime,jms:jme,kms:kme), inbuf(*)
	354	INTEGER js, je, ks, ke, is, ie, curs
	355	! Local
	356	INTEGER i,j,k,p
	357	p = 1
	358	DO k = ks, ke
	359	DO j = js, je
	360	DO i = is, ie
	361	outbuf(i,j,k) = inbuf(p)
	362	p = p + 1
	363	ENDDO
	364	ENDDO
	365	ENDDO
	366	curs = p - 1
	367	RETURN
	368	END SUBROUTINE f_unpack_int_ijk
	369
	370	SUBROUTINE f_unpack_lint_ijk ( inbuf, outbuf, js, je, ks, ke, &
	371	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	372	IMPLICIT NONE
	373	INTEGER jms, jme, kms, kme, ims, ime
	374	INTEGER8 outbuf(ims:ime,jms:jme,kms:kme), inbuf()
	375	INTEGER js, je, ks, ke, is, ie, curs
	376	! Local
	377	INTEGER i,j,k,p
	378	p = 1
	379	DO k = ks, ke
	380	DO j = js, je
	381	DO i = is, ie
	382	outbuf(i,j,k) = inbuf(p)
	383	p = p + 1
	384	ENDDO
	385	ENDDO
	386	ENDDO
	387	curs = p - 1
	388	RETURN
	389	END SUBROUTINE f_unpack_lint_ijk
	390
	391	!jik
	392	SUBROUTINE f_pack_int_jik ( inbuf, outbuf, js, je, ks, ke, &
	393	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	394	IMPLICIT NONE
	395	INTEGER jms, jme, kms, kme, ims, ime
	396	INTEGER inbuf(jms:jme,ims:ime,kms:kme), outbuf(*)
	397	INTEGER js, je, ks, ke, is, ie, curs
	398	! Local
	399	INTEGER i,j,k,p
	400	p = 1
	401	DO k = ks, ke
	402	DO i = is, ie
	403	DO j = js, je
	404	outbuf(p) = inbuf(j,i,k)
	405	p = p + 1
	406	ENDDO
	407	ENDDO
	408	ENDDO
	409	curs = p - 1
	410	RETURN
	411	END SUBROUTINE f_pack_int_jik
	412
	413	SUBROUTINE f_pack_lint_jik ( inbuf, outbuf, js, je, ks, ke, &
	414	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	415	IMPLICIT NONE
	416	INTEGER jms, jme, kms, kme, ims, ime
	417	INTEGER8 inbuf(jms:jme,ims:ime,kms:kme), outbuf()
	418	INTEGER js, je, ks, ke, is, ie, curs
	419	! Local
	420	INTEGER i,j,k,p
	421	p = 1
	422	DO k = ks, ke
	423	DO i = is, ie
	424	DO j = js, je
	425	outbuf(p) = inbuf(j,i,k)
	426	p = p + 1
	427	ENDDO
	428	ENDDO
	429	ENDDO
	430	curs = p - 1
	431	RETURN
	432	END SUBROUTINE f_pack_lint_jik
	433
	434	SUBROUTINE f_unpack_int_jik ( inbuf, outbuf, js, je, ks, ke, &
	435	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	436	IMPLICIT NONE
	437	INTEGER jms, jme, kms, kme, ims, ime
	438	INTEGER outbuf(jms:jme,ims:ime,kms:kme), inbuf(*)
	439	INTEGER js, je, ks, ke, is, ie, curs
	440	! Local
	441	INTEGER i,j,k,p
	442	p = 1
	443	DO k = ks, ke
	444	DO i = is, ie
	445	DO j = js, je
	446	outbuf(j,i,k) = inbuf(p)
	447	p = p + 1
	448	ENDDO
	449	ENDDO
	450	ENDDO
	451	curs = p - 1
	452	RETURN
	453	END SUBROUTINE f_unpack_int_jik
	454
	455	SUBROUTINE f_unpack_lint_jik ( inbuf, outbuf, js, je, ks, ke, &
	456	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	457	IMPLICIT NONE
	458	INTEGER jms, jme, kms, kme, ims, ime
	459	INTEGER8 outbuf(jms:jme,ims:ime,kms:kme), inbuf()
	460	INTEGER js, je, ks, ke, is, ie, curs
	461	! Local
	462	INTEGER i,j,k,p
	463	p = 1
	464	DO k = ks, ke
	465	DO i = is, ie
	466	DO j = js, je
	467	outbuf(j,i,k) = inbuf(p)
	468	p = p + 1
	469	ENDDO
	470	ENDDO
	471	ENDDO
	472	curs = p - 1
	473	RETURN
	474	END SUBROUTINE f_unpack_lint_jik
	475
	476	!kij
	477	SUBROUTINE f_pack_int_kij ( inbuf, outbuf, js, je, ks, ke, &
	478	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	479	IMPLICIT NONE
	480	INTEGER jms, jme, kms, kme, ims, ime
	481	INTEGER inbuf(kms:kme,ims:ime,jms:jme), outbuf(*)
	482	INTEGER js, je, ks, ke, is, ie, curs
	483	! Local
	484	INTEGER i,j,k,p
	485	p = 1
	486	DO j = js, je
	487	DO i = is, ie
	488	DO k = ks, ke
	489	outbuf(p) = inbuf(k,i,j)
	490	p = p + 1
	491	ENDDO
	492	ENDDO
	493	ENDDO
	494	curs = p - 1
	495	RETURN
	496	END SUBROUTINE f_pack_int_kij
	497
	498	SUBROUTINE f_pack_lint_kij ( inbuf, outbuf, js, je, ks, ke, &
	499	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	500	IMPLICIT NONE
	501	INTEGER jms, jme, kms, kme, ims, ime
	502	INTEGER8 inbuf(kms:kme,ims:ime,jms:jme), outbuf()
	503	INTEGER js, je, ks, ke, is, ie, curs
	504	! Local
	505	INTEGER i,j,k,p
	506	p = 1
	507	DO j = js, je
	508	DO i = is, ie
	509	DO k = ks, ke
	510	outbuf(p) = inbuf(k,i,j)
	511	p = p + 1
	512	ENDDO
	513	ENDDO
	514	ENDDO
	515	curs = p - 1
	516	RETURN
	517	END SUBROUTINE f_pack_lint_kij
	518
	519	SUBROUTINE f_unpack_int_kij ( inbuf, outbuf, js, je, ks, ke, &
	520	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	521	IMPLICIT NONE
	522	INTEGER jms, jme, kms, kme, ims, ime
	523	INTEGER outbuf(kms:kme,ims:ime,jms:jme), inbuf(*)
	524	INTEGER js, je, ks, ke, is, ie, curs
	525	! Local
	526	INTEGER i,j,k,p
	527	p = 1
	528	DO j = js, je
	529	DO i = is, ie
	530	DO k = ks, ke
	531	outbuf(k,i,j) = inbuf(p)
	532	p = p + 1
	533	ENDDO
	534	ENDDO
	535	ENDDO
	536	curs = p - 1
	537	RETURN
	538	END SUBROUTINE f_unpack_int_kij
	539
	540	SUBROUTINE f_unpack_lint_kij ( inbuf, outbuf, js, je, ks, ke, &
	541	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	542	IMPLICIT NONE
	543	INTEGER jms, jme, kms, kme, ims, ime
	544	INTEGER8 outbuf(kms:kme,ims:ime,jms:jme), inbuf()
	545	INTEGER js, je, ks, ke, is, ie, curs
	546	! Local
	547	INTEGER i,j,k,p
	548	p = 1
	549	DO j = js, je
	550	DO i = is, ie
	551	DO k = ks, ke
	552	outbuf(k,i,j) = inbuf(p)
	553	p = p + 1
	554	ENDDO
	555	ENDDO
	556	ENDDO
	557	curs = p - 1
	558	RETURN
	559	END SUBROUTINE f_unpack_lint_kij
	560
	561	!kji
	562	SUBROUTINE f_pack_int_kji ( inbuf, outbuf, js, je, ks, ke, &
	563	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	564	IMPLICIT NONE
	565	INTEGER jms, jme, kms, kme, ims, ime
	566	INTEGER inbuf(kms:kme,jms:jme,ims:ime), outbuf(*)
	567	INTEGER js, je, ks, ke, is, ie, curs
	568	! Local
	569	INTEGER i,j,k,p
	570	p = 1
	571	DO i = is, ie
	572	DO j = js, je
	573	DO k = ks, ke
	574	outbuf(p) = inbuf(k,j,i)
	575	p = p + 1
	576	ENDDO
	577	ENDDO
	578	ENDDO
	579	curs = p - 1
	580	RETURN
	581	END SUBROUTINE f_pack_int_kji
	582
	583	SUBROUTINE f_pack_lint_kji ( inbuf, outbuf, js, je, ks, ke, &
	584	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	585	IMPLICIT NONE
	586	INTEGER jms, jme, kms, kme, ims, ime
	587	INTEGER8 inbuf(kms:kme,jms:jme,ims:ime), outbuf()
	588	INTEGER js, je, ks, ke, is, ie, curs
	589	! Local
	590	INTEGER i,j,k,p
	591	p = 1
	592	DO i = is, ie
	593	DO j = js, je
	594	DO k = ks, ke
	595	outbuf(p) = inbuf(k,j,i)
	596	p = p + 1
	597	ENDDO
	598	ENDDO
	599	ENDDO
	600	curs = p - 1
	601	RETURN
	602	END SUBROUTINE f_pack_lint_kji
	603
	604	SUBROUTINE f_unpack_int_kji ( inbuf, outbuf, js, je, ks, ke, &
	605	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	606	IMPLICIT NONE
	607	INTEGER jms, jme, kms, kme, ims, ime
	608	INTEGER outbuf(kms:kme,jms:jme,ims:ime), inbuf(*)
	609	INTEGER js, je, ks, ke, is, ie, curs
	610	! Local
	611	INTEGER i,j,k,p
	612	p = 1
	613	DO i = is, ie
	614	DO j = js, je
	615	DO k = ks, ke
	616	outbuf(k,j,i) = inbuf(p)
	617	p = p + 1
	618	ENDDO
	619	ENDDO
	620	ENDDO
	621	curs = p - 1
	622	RETURN
	623	END SUBROUTINE f_unpack_int_kji
	624
	625	SUBROUTINE f_unpack_lint_kji ( inbuf, outbuf, js, je, ks, ke, &
	626	& is, ie, jms, jme, kms, kme, ims, ime, curs )
	627	IMPLICIT NONE
	628	INTEGER jms, jme, kms, kme, ims, ime
	629	INTEGER8 outbuf(kms:kme,jms:jme,ims:ime), inbuf()
	630	INTEGER js, je, ks, ke, is, ie, curs
	631	! Local
	632	INTEGER i,j,k,p
	633	p = 1
	634	DO i = is, ie
	635	DO j = js, je
	636	DO k = ks, ke
	637	outbuf(k,j,i) = inbuf(p)
	638	p = p + 1
	639	ENDDO
	640	ENDDO
	641	ENDDO
	642	curs = p - 1
	643	RETURN
	644	END SUBROUTINE f_unpack_lint_kji
	645

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

Download in other formats:

Original Format