/[lmdze]/trunk/libf/IOIPSL/mathop2.f90
ViewVC logotype

Contents of /trunk/libf/IOIPSL/mathop2.f90

Parent Directory Parent Directory | Revision Log Revision Log

Revision 62 - (show annotations)
Thu Jul 26 14:37:37 2012 UTC (11 years, 10 months ago) by guez
File size: 53000 byte(s) 
Changed handling of compiler in compilation system.

Removed the prefix letters "y", "p", "t" or "z" in some names of variables.

Replaced calls to NetCDF by calls to NetCDF95.

Extracted "ioget_calendar" procedures from "calendar.f90" into a
separate file.

Extracted to a separate file, "mathop2.f90", procedures that were not
part of the generic interface "mathop" in "mathop.f90".

Removed computation of "dq" in "bilan_dyn", which was not used.

In "iniadvtrac", removed schemes 20 Slopes and 30 Prather. Was not
compatible with declarations of array sizes.

In "clcdrag", "ustarhb", "vdif_kcay", "yamada4" and "coefkz", changed
the size of some arrays from "klon" to "knon".

Removed possible call to "conema3" in "physiq".

Removed unused argument "cd" in "yamada".
1 MODULE mathop2
2
3 ! From mathelp.f90, version 2.0 2004/04/05 14:47:50
4
5 implicit none
6
7 CONTAINS
8
9 !=== FUNCTIONS (only one argument)
10 !-
11 INTEGER FUNCTION ma_sin_r11(nb, x, nbo, y)
12 INTEGER :: nb, nbo, i
13 REAL :: x(nb), y(nbo)
14 !---------------------------------------------------------------------
15 DO i=1, nb
16 y(i) = SIN(x(i))
17 ENDDO
18
19 nbo = nb
20 ma_sin_r11 = 0
21 !----------------------
22 END FUNCTION ma_sin_r11
23
24 !************************************************
25
26 INTEGER FUNCTION ma_cos_r11(nb, x, nbo, y)
27 INTEGER :: nb, nbo, i
28 REAL :: x(nb), y(nbo)
29 !---------------------------------------------------------------------
30 DO i=1, nb
31 y(i) = COS(x(i))
32 ENDDO
33
34 nbo = nb
35 ma_cos_r11 = 0
36 !----------------------
37 END FUNCTION ma_cos_r11
38
39 !************************************************
40
41 INTEGER FUNCTION ma_tan_r11(nb, x, nbo, y)
42 INTEGER :: nb, nbo, i
43 REAL :: x(nb), y(nbo)
44 !---------------------------------------------------------------------
45 DO i=1, nb
46 y(i) = TAN(x(i))
47 ENDDO
48
49 nbo = nb
50 ma_tan_r11 = 0
51 !----------------------
52 END FUNCTION ma_tan_r11
53
54 !************************************************
55
56 INTEGER FUNCTION ma_asin_r11(nb, x, nbo, y)
57 INTEGER :: nb, nbo, i
58 REAL :: x(nb), y(nbo)
59 !---------------------------------------------------------------------
60 DO i=1, nb
61 y(i) = ASIN(x(i))
62 ENDDO
63
64 nbo = nb
65 ma_asin_r11 = 0
66 !-----------------------
67 END FUNCTION ma_asin_r11
68
69 !************************************************
70
71 INTEGER FUNCTION ma_acos_r11(nb, x, nbo, y)
72 INTEGER :: nb, nbo, i
73 REAL :: x(nb), y(nbo)
74 !---------------------------------------------------------------------
75 DO i=1, nb
76 y(i) = ACOS(x(i))
77 ENDDO
78
79 nbo = nb
80 ma_acos_r11 = 0
81 !-----------------------
82 END FUNCTION ma_acos_r11
83
84 !************************************************
85
86 INTEGER FUNCTION ma_atan_r11(nb, x, nbo, y)
87 INTEGER :: nb, nbo, i
88 REAL :: x(nb), y(nbo)
89 !---------------------------------------------------------------------
90 DO i=1, nb
91 y(i) = ATAN(x(i))
92 ENDDO
93
94 nbo = nb
95 ma_atan_r11 = 0
96 !-----------------------
97 END FUNCTION ma_atan_r11
98
99 !************************************************
100
101 INTEGER FUNCTION ma_exp_r11(nb, x, nbo, y)
102 INTEGER :: nb, nbo, i
103 REAL :: x(nb), y(nbo)
104 !---------------------------------------------------------------------
105 DO i=1, nb
106 y(i) = EXP(x(i))
107 ENDDO
108
109 nbo = nb
110 ma_exp_r11 = 0
111 !----------------------
112 END FUNCTION ma_exp_r11
113
114 !************************************************
115
116 INTEGER FUNCTION ma_alog_r11(nb, x, nbo, y)
117 INTEGER :: nb, nbo, i
118 REAL :: x(nb), y(nbo)
119 !---------------------------------------------------------------------
120 DO i=1, nb
121 y(i) = alog(x(i))
122 ENDDO
123
124 nbo = nb
125 ma_alog_r11 = 0
126 !-----------------------
127 END FUNCTION ma_alog_r11
128
129 !************************************************
130
131 INTEGER FUNCTION ma_sqrt_r11(nb, x, nbo, y)
132 INTEGER :: nb, nbo, i
133 REAL :: x(nb), y(nbo)
134 !---------------------------------------------------------------------
135 DO i=1, nb
136 y(i) = SQRT(x(i))
137 ENDDO
138
139 nbo = nb
140 ma_sqrt_r11 = 0
141 !-----------------------
142 END FUNCTION ma_sqrt_r11
143
144 !************************************************
145
146 INTEGER FUNCTION ma_abs_r11(nb, x, nbo, y)
147 INTEGER :: nb, nbo, i
148 REAL :: x(nb), y(nbo)
149 !---------------------------------------------------------------------
150 DO i=1, nb
151 y(i) = ABS(x(i))
152 ENDDO
153
154 nbo = nb
155 ma_abs_r11 = 0
156 !----------------------
157 END FUNCTION ma_abs_r11
158
159 !************************************************
160
161 INTEGER FUNCTION ma_chs_r11(nb, x, nbo, y)
162 INTEGER :: nb, nbo, i
163 REAL :: x(nb), y(nbo)
164 !---------------------------------------------------------------------
165 DO i=1, nb
166 y(i) = x(i)*(-1.)
167 ENDDO
168
169 nbo = nb
170 ma_chs_r11 = 0
171 !----------------------
172 END FUNCTION ma_chs_r11
173
174 !************************************************
175
176 INTEGER FUNCTION ma_cels_r11(nb, x, nbo, y)
177 INTEGER :: nb, nbo, i
178 REAL :: x(nb), y(nbo)
179 !---------------------------------------------------------------------
180 DO i=1, nb
181 y(i) = x(i)-273.15
182 ENDDO
183
184 nbo = nb
185 ma_cels_r11 = 0
186 !-----------------------
187 END FUNCTION ma_cels_r11
188
189 !************************************************
190
191 INTEGER FUNCTION ma_kelv_r11(nb, x, nbo, y)
192 INTEGER :: nb, nbo, i
193 REAL :: x(nb), y(nbo)
194 !---------------------------------------------------------------------
195 DO i=1, nb
196 y(i) = x(i)+273.15
197 ENDDO
198
199 nbo = nb
200 ma_kelv_r11 = 0
201 !-----------------------
202 END FUNCTION ma_kelv_r11
203
204 !************************************************
205
206 INTEGER FUNCTION ma_deg_r11(nb, x, nbo, y)
207 INTEGER :: nb, nbo, i
208 REAL :: x(nb), y(nbo)
209 !---------------------------------------------------------------------
210 DO i=1, nb
211 y(i) = x(i)*57.29577951
212 ENDDO
213
214 nbo = nb
215 ma_deg_r11 = 0
216 !-----------------------
217 END FUNCTION ma_deg_r11
218
219 !************************************************
220
221 INTEGER FUNCTION ma_rad_r11(nb, x, nbo, y)
222 INTEGER :: nb, nbo, i
223 REAL :: x(nb), y(nbo)
224 !---------------------------------------------------------------------
225 DO i=1, nb
226 y(i) = x(i)*0.01745329252
227 ENDDO
228
229 nbo = nb
230 ma_rad_r11 = 0
231 !----------------------
232 END FUNCTION ma_rad_r11
233
234 !************************************************
235
236 INTEGER FUNCTION ma_ident_r11(nb, x, nbo, y)
237 INTEGER :: nb, nbo, i
238 REAL :: x(nb), y(nbo)
239 !---------------------------------------------------------------------
240 DO i=1, nb
241 y(i) = x(i)
242 ENDDO
243
244 nbo = nb
245 ma_ident_r11 = 0
246 !------------------------
247 END FUNCTION ma_ident_r11
248 !-
249 !=== OPERATIONS (two argument)
250 !-
251 INTEGER FUNCTION ma_add_r11(nb, x, s, nbo, y)
252 INTEGER :: nb, nbo
253 REAL :: x(nb), s, y(nbo)
254
255 INTEGER :: i
256 !---------------------------------------------------------------------
257 DO i=1, nb
258 y(i) = x(i)+s
259 ENDDO
260
261 nbo = nb
262 ma_add_r11 = 0
263 !-----------------------
264 END FUNCTION ma_add_r11
265
266 !************************************************
267
268 INTEGER FUNCTION ma_sub_r11(nb, x, s, nbo, y)
269 INTEGER :: nb, nbo
270 REAL :: x(nb), s, y(nbo)
271
272 INTEGER :: i
273 !---------------------------------------------------------------------
274 DO i=1, nb
275 y(i) = x(i)-s
276 ENDDO
277
278 nbo = nb
279 ma_sub_r11 = 0
280 !----------------------
281 END FUNCTION ma_sub_r11
282
283 !************************************************
284
285 INTEGER FUNCTION ma_subi_r11(nb, x, s, nbo, y)
286 INTEGER :: nb, nbo
287 REAL :: x(nb), s, y(nbo)
288
289 INTEGER :: i
290 !---------------------------------------------------------------------
291 DO i=1, nb
292 y(i) = s-x(i)
293 ENDDO
294
295 nbo = nb
296 ma_subi_r11 = 0
297 !-----------------------
298 END FUNCTION ma_subi_r11
299
300 !************************************************
301
302 INTEGER FUNCTION ma_mult_r11(nb, x, s, nbo, y)
303 INTEGER :: nb, nbo
304 REAL :: x(nb), s, y(nbo)
305
306 INTEGER :: i
307 !---------------------------------------------------------------------
308 DO i=1, nb
309 y(i) = x(i)*s
310 ENDDO
311
312 nbo = nb
313 ma_mult_r11 = 0
314 !-----------------------
315 END FUNCTION ma_mult_r11
316
317 !************************************************
318
319 INTEGER FUNCTION ma_div_r11(nb, x, s, nbo, y)
320 INTEGER :: nb, nbo
321 REAL :: x(nb), s, y(nbo)
322
323 INTEGER :: i
324 !---------------------------------------------------------------------
325 DO i=1, nb
326 y(i) = x(i)/s
327 ENDDO
328
329 nbo = nb
330 ma_div_r11 = 0
331 !-----------------------
332 END FUNCTION ma_div_r11
333
334 !************************************************
335
336 INTEGER FUNCTION ma_divi_r11(nb, x, s, nbo, y)
337 INTEGER :: nb, nbo
338 REAL :: x(nb), s, y(nbo)
339
340 INTEGER :: i
341 !---------------------------------------------------------------------
342 DO i=1, nb
343 y(i) = s/x(i)
344 ENDDO
345
346 nbo = nb
347 ma_divi_r11 = 0
348 !-----------------------
349 END FUNCTION ma_divi_r11
350
351 !************************************************
352
353 INTEGER FUNCTION ma_power_r11(nb, x, s, nbo, y)
354 INTEGER :: nb, nbo
355 REAL :: x(nb), s, y(nbo)
356
357 INTEGER :: i
358 !---------------------------------------------------------------------
359 DO i=1, nb
360 y(i) = x(i)**s
361 ENDDO
362
363 nbo = nb
364 ma_power_r11 = 0
365 !-----------------------
366 END FUNCTION ma_power_r11
367
368 !************************************************
369
370 INTEGER FUNCTION ma_fumin_r11(nb, x, s, nbo, y)
371 INTEGER :: nb, nbo
372 REAL :: x(nb), s, y(nbo)
373
374 INTEGER :: i
375 !---------------------------------------------------------------------
376 DO i=1, nb
377 y(i) = MIN(x(i), s)
378 ENDDO
379
380 nbo = nb
381 ma_fumin_r11 = 0
382 !------------------------
383 END FUNCTION ma_fumin_r11
384
385 !************************************************
386
387 INTEGER FUNCTION ma_fumax_r11(nb, x, s, nbo, y)
388 INTEGER :: nb, nbo
389 REAL :: x(nb), s, y(nbo)
390
391 INTEGER :: i
392 !---------------------------------------------------------------------
393 DO i=1, nb
394 y(i) = MAX(x(i), s)
395 ENDDO
396
397 nbo = nb
398 ma_fumax_r11 = 0
399 !------------------------
400 END FUNCTION ma_fumax_r11
401
402 !************************************************
403
404 INTEGER FUNCTION ma_fuscat_r11(nb, x, nbi, ind, miss_val, nbo, y)
405 INTEGER :: nb, nbo, nbi
406 INTEGER :: ind(nbi)
407 REAL :: x(nb), miss_val, y(nbo)
408
409 INTEGER :: i, ii, ipos
410 !---------------------------------------------------------------------
411 ma_fuscat_r11 = 0
412
413 y(1:nbo) = miss_val
414
415 IF (nbi <= nb) THEN
416 ipos = 0
417 DO i=1, nbi
418 IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
419 ipos = ipos+1
420 y(ind(i)) = x(ipos)
421 ELSE
422 IF (ind(i) > nbo) ma_fuscat_r11 = ma_fuscat_r11+1
423 ENDIF
424 ENDDO
425 !-- Repeat the data if needed
426 IF (MINVAL(ind) < 0) THEN
427 DO i=1, nbi
428 IF (ind(i) <= 0) THEN
429 DO ii=1, ABS(ind(i))-1
430 IF (ind(i+1)+ii <= nbo) THEN
431 y(ind(i+1)+ii) = y(ind(i+1))
432 ELSE
433 ma_fuscat_r11 = ma_fuscat_r11+1
434 ENDIF
435 ENDDO
436 ENDIF
437 ENDDO
438 ENDIF
439 ELSE
440 ma_fuscat_r11 = 1
441 ENDIF
442 !-------------------------
443 END FUNCTION ma_fuscat_r11
444
445 !************************************************
446
447 INTEGER FUNCTION ma_fugath_r11(nb, x, nbi, ind, miss_val, nbo, y)
448 INTEGER :: nb, nbo, nbi
449 INTEGER :: ind(nbi)
450 REAL :: x(nb), miss_val, y(nbo)
451
452 INTEGER :: i, ipos
453 !---------------------------------------------------------------------
454 IF (nbi <= nbo) THEN
455 ma_fugath_r11 = 0
456 y(1:nbo) = miss_val
457 ipos = 0
458 DO i=1, nbi
459 IF (ipos+1 <= nbo) THEN
460 IF (ind(i) > 0) THEN
461 ipos = ipos+1
462 y(ipos) = x(ind(i))
463 ENDIF
464 ELSE
465 IF (ipos+1 > nbo) ma_fugath_r11 = ma_fugath_r11+1
466 ENDIF
467 ENDDO
468 ELSE
469 ma_fugath_r11 = 1
470 ENDIF
471
472 nbo = ipos
473 !-------------------------
474 END FUNCTION ma_fugath_r11
475
476 !************************************************
477
478 INTEGER FUNCTION ma_fufill_r11(nb, x, nbi, ind, miss_val, nbo, y)
479 INTEGER :: nb, nbo, nbi
480 INTEGER :: ind(nbi)
481 REAL :: x(nb), miss_val, y(nbo)
482
483 INTEGER :: i, ii, ipos
484 !---------------------------------------------------------------------
485 ma_fufill_r11 = 0
486
487 IF (nbi <= nb) THEN
488 ipos = 0
489 DO i=1, nbi
490 IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
491 ipos = ipos+1
492 y(ind(i)) = x(ipos)
493 ELSE
494 IF (ind(i) > nbo) ma_fufill_r11 = ma_fufill_r11+1
495 ENDIF
496 ENDDO
497 !-- Repeat the data if needed
498 IF (MINVAL(ind) < 0) THEN
499 DO i=1, nbi
500 IF (ind(i) <= 0) THEN
501 DO ii=1, ABS(ind(i))-1
502 IF (ind(i+1)+ii <= nbo) THEN
503 y(ind(i+1)+ii) = y(ind(i+1))
504 ELSE
505 ma_fufill_r11 = ma_fufill_r11+1
506 ENDIF
507 ENDDO
508 ENDIF
509 ENDDO
510 ENDIF
511 ELSE
512 ma_fufill_r11 = 1
513 ENDIF
514 !-------------------------
515 END FUNCTION ma_fufill_r11
516
517 !************************************************
518
519 INTEGER FUNCTION ma_fucoll_r11(nb, x, nbi, ind, miss_val, nbo, y)
520 INTEGER :: nb, nbo, nbi
521 INTEGER :: ind(nbi)
522 REAL :: x(nb), miss_val, y(nbo)
523
524 INTEGER :: i, ipos
525 !---------------------------------------------------------------------
526 IF (nbi <= nbo) THEN
527 ma_fucoll_r11 = 0
528 ipos = 0
529 DO i=1, nbi
530 IF (ipos+1 <= nbo) THEN
531 IF (ind(i) > 0) THEN
532 ipos = ipos+1
533 y(ipos) = x(ind(i))
534 ENDIF
535 ELSE
536 IF (ipos+1 > nbo) ma_fucoll_r11 = ma_fucoll_r11+1
537 ENDIF
538 ENDDO
539 ELSE
540 ma_fucoll_r11 = 1
541 ENDIF
542
543 nbo = ipos
544 !-------------------------
545 END FUNCTION ma_fucoll_r11
546
547 !************************************************
548
549 INTEGER FUNCTION ma_fuundef_r11(nb, x, nbi, ind, miss_val, nbo, y)
550 INTEGER :: nb, nbo, nbi
551 INTEGER :: ind(nbi)
552 REAL :: x(nb), miss_val, y(nbo)
553
554 INTEGER :: i
555 !---------------------------------------------------------------------
556 IF (nbi <= nbo .AND. nbo == nb) THEN
557 ma_fuundef_r11 = 0
558 DO i=1, nbo
559 y(i) = x(i)
560 ENDDO
561 DO i=1, nbi
562 IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
563 y(ind(i)) = miss_val
564 ELSE
565 IF (ind(i) > nbo) ma_fuundef_r11 = ma_fuundef_r11+1
566 ENDIF
567 ENDDO
568 ELSE
569 ma_fuundef_r11 = 1
570 ENDIF
571 !--------------------------
572 END FUNCTION ma_fuundef_r11
573
574 !************************************************
575
576 INTEGER FUNCTION ma_fuonly_r11(nb, x, nbi, ind, miss_val, nbo, y)
577 INTEGER :: nb, nbo, nbi
578 INTEGER :: ind(nbi)
579 REAL :: x(nb), miss_val, y(nbo)
580
581 INTEGER :: i
582 !---------------------------------------------------------------------
583 IF ( (nbi <= nbo).AND.(nbo == nb) &
584 & .AND.ALL(ind(1:nbi) <= nbo) ) THEN
585 ma_fuonly_r11 = 0
586 y(1:nbo) = miss_val
587 DO i=1, nbi
588 IF (ind(i) > 0) THEN
589 y(ind(i)) = x(ind(i))
590 ENDIF
591 ENDDO
592 ELSE
593 ma_fuonly_r11 = 1
594 ENDIF
595 !-------------------------
596 END FUNCTION ma_fuonly_r11
597
598 !************************************************
599
600 !************************************************
601
602 !=== FUNCTIONS (only one argument)
603 !-
604 INTEGER FUNCTION ma_sin_r21(nb, x, nbo, y)
605 INTEGER :: nb(2), nbo, i, j, ij
606 REAL :: x(nb(1), nb(2)), y(nbo)
607 !---------------------------------------------------------------------
608 ij = 0
609 DO j=1, nb(2)
610 DO i=1, nb(1)
611 ij = ij+1
612 y(ij) = SIN(x(i, j))
613 ENDDO
614 ENDDO
615
616 nbo = nb(1)*nb(2)
617 ma_sin_r21 = 0
618 !----------------------
619 END FUNCTION ma_sin_r21
620
621 !************************************************
622
623 INTEGER FUNCTION ma_cos_r21(nb, x, nbo, y)
624 INTEGER :: nb(2), nbo, i, j, ij
625 REAL :: x(nb(1), nb(2)), y(nbo)
626 !---------------------------------------------------------------------
627 ij = 0
628 DO j=1, nb(2)
629 DO i=1, nb(1)
630 ij = ij+1
631 y(ij) = COS(x(i, j))
632 ENDDO
633 ENDDO
634
635 nbo = nb(1)*nb(2)
636 ma_cos_r21 = 0
637 !----------------------
638 END FUNCTION ma_cos_r21
639
640 !************************************************
641
642 INTEGER FUNCTION ma_tan_r21(nb, x, nbo, y)
643 INTEGER :: nb(2), nbo, i, j, ij
644 REAL :: x(nb(1), nb(2)), y(nbo)
645 !---------------------------------------------------------------------
646 ij = 0
647 DO j=1, nb(2)
648 DO i=1, nb(1)
649 ij = ij+1
650 y(ij) = TAN(x(i, j))
651 ENDDO
652 ENDDO
653
654 nbo = nb(1)*nb(2)
655 ma_tan_r21 = 0
656 !----------------------
657 END FUNCTION ma_tan_r21
658
659 !************************************************
660
661 INTEGER FUNCTION ma_asin_r21(nb, x, nbo, y)
662 INTEGER :: nb(2), nbo, i, j, ij
663 REAL :: x(nb(1), nb(2)), y(nbo)
664 !---------------------------------------------------------------------
665 ij = 0
666 DO j=1, nb(2)
667 DO i=1, nb(1)
668 ij = ij+1
669 y(ij) = ASIN(x(i, j))
670 ENDDO
671 ENDDO
672
673 nbo = nb(1)*nb(2)
674 ma_asin_r21 = 0
675 !-----------------------
676 END FUNCTION ma_asin_r21
677
678 !************************************************
679
680 INTEGER FUNCTION ma_acos_r21(nb, x, nbo, y)
681 INTEGER :: nb(2), nbo, i, j, ij
682 REAL :: x(nb(1), nb(2)), y(nbo)
683 !---------------------------------------------------------------------
684 ij = 0
685 DO j=1, nb(2)
686 DO i=1, nb(1)
687 ij = ij+1
688 y(ij) = ACOS(x(i, j))
689 ENDDO
690 ENDDO
691
692 nbo = nb(1)*nb(2)
693 ma_acos_r21 = 0
694 !-----------------------
695 END FUNCTION ma_acos_r21
696
697 !************************************************
698
699 INTEGER FUNCTION ma_atan_r21(nb, x, nbo, y)
700 INTEGER :: nb(2), nbo, i, j, ij
701 REAL :: x(nb(1), nb(2)), y(nbo)
702 !---------------------------------------------------------------------
703 ij = 0
704 DO j=1, nb(2)
705 DO i=1, nb(1)
706 ij = ij+1
707 y(ij) = ATAN(x(i, j))
708 ENDDO
709 ENDDO
710
711 nbo = nb(1)*nb(2)
712 ma_atan_r21 = 0
713 !-----------------------
714 END FUNCTION ma_atan_r21
715
716 !************************************************
717
718 INTEGER FUNCTION ma_exp_r21(nb, x, nbo, y)
719 INTEGER :: nb(2), nbo, i, j, ij
720 REAL :: x(nb(1), nb(2)), y(nbo)
721 !---------------------------------------------------------------------
722 ij = 0
723 DO j=1, nb(2)
724 DO i=1, nb(1)
725 ij = ij+1
726 y(ij) = EXP(x(i, j))
727 ENDDO
728 ENDDO
729
730 nbo = nb(1)*nb(2)
731 ma_exp_r21 = 0
732 !----------------------
733 END FUNCTION ma_exp_r21
734
735 !************************************************
736
737 INTEGER FUNCTION ma_alog_r21(nb, x, nbo, y)
738 INTEGER :: nb(2), nbo, i, j, ij
739 REAL :: x(nb(1), nb(2)), y(nbo)
740 !---------------------------------------------------------------------
741 ij = 0
742 DO j=1, nb(2)
743 DO i=1, nb(1)
744 ij = ij+1
745 y(ij) = ALOG(x(i, j))
746 ENDDO
747 ENDDO
748
749 nbo = nb(1)*nb(2)
750 ma_alog_r21 = 0
751 !-----------------------
752 END FUNCTION ma_alog_r21
753
754 !************************************************
755
756 INTEGER FUNCTION ma_sqrt_r21(nb, x, nbo, y)
757 INTEGER :: nb(2), nbo, i, j, ij
758 REAL :: x(nb(1), nb(2)), y(nbo)
759 !---------------------------------------------------------------------
760 ij = 0
761 DO j=1, nb(2)
762 DO i=1, nb(1)
763 ij = ij+1
764 y(ij) = SQRT(x(i, j))
765 ENDDO
766 ENDDO
767
768 nbo = nb(1)*nb(2)
769 ma_sqrt_r21 = 0
770 !-----------------------
771 END FUNCTION ma_sqrt_r21
772
773 !************************************************
774
775 INTEGER FUNCTION ma_abs_r21(nb, x, nbo, y)
776 INTEGER :: nb(2), nbo, i, j, ij
777 REAL :: x(nb(1), nb(2)), y(nbo)
778 !---------------------------------------------------------------------
779 ij = 0
780 DO j=1, nb(2)
781 DO i=1, nb(1)
782 ij = ij+1
783 y(ij) = ABS(x(i, j))
784 ENDDO
785 ENDDO
786
787 nbo = nb(1)*nb(2)
788 ma_abs_r21 = 0
789 !----------------------
790 END FUNCTION ma_abs_r21
791
792 !************************************************
793
794 INTEGER FUNCTION ma_chs_r21(nb, x, nbo, y)
795 INTEGER :: nb(2), nbo, i, j, ij
796 REAL :: x(nb(1), nb(2)), y(nbo)
797 !---------------------------------------------------------------------
798 ij = 0
799 DO j=1, nb(2)
800 DO i=1, nb(1)
801 ij = ij+1
802 y(ij) = x(i, j)*(-1.)
803 ENDDO
804 ENDDO
805
806 nbo = nb(1)*nb(2)
807 ma_chs_r21 = 0
808 !----------------------
809 END FUNCTION ma_chs_r21
810
811 !************************************************
812
813 INTEGER FUNCTION ma_cels_r21(nb, x, nbo, y)
814 INTEGER :: nb(2), nbo, i, j, ij
815 REAL :: x(nb(1), nb(2)), y(nbo)
816 !---------------------------------------------------------------------
817 ij = 0
818 DO j=1, nb(2)
819 DO i=1, nb(1)
820 ij = ij+1
821 y(ij) = x(i, j)-273.15
822 ENDDO
823 ENDDO
824
825 nbo = nb(1)*nb(2)
826 ma_cels_r21 = 0
827 !-----------------------
828 END FUNCTION ma_cels_r21
829
830 !************************************************
831
832 INTEGER FUNCTION ma_kelv_r21(nb, x, nbo, y)
833 INTEGER :: nb(2), nbo, i, j, ij
834 REAL :: x(nb(1), nb(2)), y(nbo)
835 !---------------------------------------------------------------------
836 ij = 0
837 DO j=1, nb(2)
838 DO i=1, nb(1)
839 ij = ij+1
840 y(ij) = x(i, j)+273.15
841 ENDDO
842 ENDDO
843
844 nbo = nb(1)*nb(2)
845 ma_kelv_r21 = 0
846 !-----------------------
847 END FUNCTION ma_kelv_r21
848
849 !************************************************
850
851 INTEGER FUNCTION ma_deg_r21(nb, x, nbo, y)
852 INTEGER :: nb(2), nbo, i, j, ij
853 REAL :: x(nb(1), nb(2)), y(nbo)
854 !---------------------------------------------------------------------
855 ij = 0
856 DO j=1, nb(2)
857 DO i=1, nb(1)
858 ij = ij+1
859 y(ij) = x(i, j)*57.29577951
860 ENDDO
861 ENDDO
862
863 nbo = nb(1)*nb(2)
864 ma_deg_r21 = 0
865 !----------------------
866 END FUNCTION ma_deg_r21
867
868 !************************************************
869
870 INTEGER FUNCTION ma_rad_r21(nb, x, nbo, y)
871 INTEGER :: nb(2), nbo, i, j, ij
872 REAL :: x(nb(1), nb(2)), y(nbo)
873 !---------------------------------------------------------------------
874 ij = 0
875 DO j=1, nb(2)
876 DO i=1, nb(1)
877 ij = ij+1
878 y(ij) = x(i, j)*0.01745329252
879 ENDDO
880 ENDDO
881
882 nbo = nb(1)*nb(2)
883 ma_rad_r21 = 0
884 !----------------------
885 END FUNCTION ma_rad_r21
886
887 !************************************************
888
889 INTEGER FUNCTION ma_ident_r21(nb, x, nbo, y)
890 INTEGER :: nb(2), nbo, i, j, ij
891 REAL :: x(nb(1), nb(2)), y(nbo)
892 !---------------------------------------------------------------------
893 ij = 0
894 DO j=1, nb(2)
895 DO i=1, nb(1)
896 ij = ij+1
897 y(ij) = x(i, j)
898 ENDDO
899 ENDDO
900
901 nbo = nb(1)*nb(2)
902 ma_ident_r21 = 0
903 !------------------------
904 END FUNCTION ma_ident_r21
905 !-
906 !=== OPERATIONS (two argument)
907 !-
908 INTEGER FUNCTION ma_add_r21(nb, x, s, nbo, y)
909 INTEGER :: nb(2), nbo
910 REAL :: x(nb(1), nb(2)), s, y(nbo)
911
912 INTEGER :: i, j, ij
913 !---------------------------------------------------------------------
914 ij = 0
915 DO j=1, nb(2)
916 DO i=1, nb(1)
917 ij = ij+1
918 y(ij) = x(i, j)+s
919 ENDDO
920 ENDDO
921
922 nbo = nb(1)*nb(2)
923 ma_add_r21 = 0
924 !----------------------
925 END FUNCTION ma_add_r21
926
927 !************************************************
928
929 INTEGER FUNCTION ma_sub_r21(nb, x, s, nbo, y)
930 INTEGER :: nb(2), nbo
931 REAL :: x(nb(1), nb(2)), s, y(nbo)
932
933 INTEGER :: i, j, ij
934 !---------------------------------------------------------------------
935 ij = 0
936 DO j=1, nb(2)
937 DO i=1, nb(1)
938 ij = ij+1
939 y(ij) = x(i, j)-s
940 ENDDO
941 ENDDO
942
943 nbo = nb(1)*nb(2)
944 ma_sub_r21 = 0
945 !----------------------
946 END FUNCTION ma_sub_r21
947
948 !************************************************
949
950 INTEGER FUNCTION ma_subi_r21(nb, x, s, nbo, y)
951 INTEGER :: nb(2), nbo
952 REAL :: x(nb(1), nb(2)), s, y(nbo)
953
954 INTEGER :: i, j, ij
955 !---------------------------------------------------------------------
956 ij = 0
957 DO j=1, nb(2)
958 DO i=1, nb(1)
959 ij = ij+1
960 y(ij) = s-x(i, j)
961 ENDDO
962 ENDDO
963
964 nbo = nb(1)*nb(2)
965 ma_subi_r21 = 0
966 !-----------------------
967 END FUNCTION ma_subi_r21
968
969 !************************************************
970
971 INTEGER FUNCTION ma_mult_r21(nb, x, s, nbo, y)
972 INTEGER :: nb(2), nbo
973 REAL :: x(nb(1), nb(2)), s, y(nbo)
974
975 INTEGER :: i, j, ij
976 !---------------------------------------------------------------------
977 ij = 0
978 DO j=1, nb(2)
979 DO i=1, nb(1)
980 ij = ij+1
981 y(ij) = x(i, j)*s
982 ENDDO
983 ENDDO
984
985 nbo = nb(1)*nb(2)
986 ma_mult_r21 = 0
987 !-----------------------
988 END FUNCTION ma_mult_r21
989
990 !************************************************
991
992 INTEGER FUNCTION ma_div_r21(nb, x, s, nbo, y)
993 INTEGER :: nb(2), nbo
994 REAL :: x(nb(1), nb(2)), s, y(nbo)
995
996 INTEGER :: i, j, ij
997 !---------------------------------------------------------------------
998 ij = 0
999 DO j=1, nb(2)
1000 DO i=1, nb(1)
1001 ij = ij+1
1002 y(ij) = x(i, j)/s
1003 ENDDO
1004 ENDDO
1005
1006 nbo = nb(1)*nb(2)
1007 ma_div_r21 = 0
1008 !----------------------
1009 END FUNCTION ma_div_r21
1010
1011 !************************************************
1012
1013 INTEGER FUNCTION ma_divi_r21(nb, x, s, nbo, y)
1014 INTEGER :: nb(2), nbo
1015 REAL :: x(nb(1), nb(2)), s, y(nbo)
1016
1017 INTEGER :: i, j, ij
1018 !---------------------------------------------------------------------
1019 ij = 0
1020 DO j=1, nb(2)
1021 DO i=1, nb(1)
1022 ij = ij+1
1023 y(ij) = s/x(i, j)
1024 ENDDO
1025 ENDDO
1026
1027 nbo = nb(1)*nb(2)
1028 ma_divi_r21 = 0
1029 !-----------------------
1030 END FUNCTION ma_divi_r21
1031
1032 !************************************************
1033
1034 INTEGER FUNCTION ma_power_r21(nb, x, s, nbo, y)
1035 INTEGER :: nb(2), nbo
1036 REAL :: x(nb(1), nb(2)), s, y(nbo)
1037
1038 INTEGER :: i, j, ij
1039 !---------------------------------------------------------------------
1040 ij = 0
1041 DO j=1, nb(2)
1042 DO i=1, nb(1)
1043 ij = ij+1
1044 y(ij) = x(i, j) ** s
1045 ENDDO
1046 ENDDO
1047
1048 nbo = nb(1)*nb(2)
1049 ma_power_r21 = 0
1050 !------------------------
1051 END FUNCTION ma_power_r21
1052
1053 !************************************************
1054
1055 INTEGER FUNCTION ma_fumin_r21(nb, x, s, nbo, y)
1056 INTEGER :: nb(2), nbo
1057 REAL :: x(nb(1), nb(2)), s, y(nbo)
1058
1059 INTEGER :: i, j, ij
1060 !---------------------------------------------------------------------
1061 ij = 0
1062 DO j=1, nb(2)
1063 DO i=1, nb(1)
1064 ij = ij+1
1065 y(ij) = MIN(x(i, j), s)
1066 ENDDO
1067 ENDDO
1068
1069 nbo = nb(1)*nb(2)
1070 ma_fumin_r21 = 0
1071 !------------------------
1072 END FUNCTION ma_fumin_r21
1073
1074 !************************************************
1075
1076 INTEGER FUNCTION ma_fumax_r21(nb, x, s, nbo, y)
1077 INTEGER :: nb(2), nbo
1078 REAL :: x(nb(1), nb(2)), s, y(nbo)
1079
1080 INTEGER :: i, j, ij
1081 !---------------------------------------------------------------------
1082 ij = 0
1083 DO j=1, nb(2)
1084 DO i=1, nb(1)
1085 ij = ij+1
1086 y(ij) = MAX(x(i, j), s)
1087 ENDDO
1088 ENDDO
1089
1090 nbo = nb(1)*nb(2)
1091 ma_fumax_r21 = 0
1092 !------------------------
1093 END FUNCTION ma_fumax_r21
1094
1095 !************************************************
1096
1097 INTEGER FUNCTION ma_fuscat_r21(nb, x, nbi, ind, miss_val, nbo, y)
1098 INTEGER :: nb(2), nbo, nbi
1099 INTEGER :: ind(nbi)
1100 REAL :: x(nb(1), nb(2)), miss_val, y(nbo)
1101
1102 INTEGER :: i, j, ij, ii, ipos
1103 !---------------------------------------------------------------------
1104 ma_fuscat_r21 = 0
1105
1106 y(1:nbo) = miss_val
1107
1108 IF (nbi <= nb(1)*nb(2)) THEN
1109 ipos = 0
1110 DO ij=1, nbi
1111 IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
1112 ipos = ipos+1
1113 j = ((ipos-1)/nb(1))+1
1114 i = (ipos-(j-1)*nb(1))
1115 y(ind(ij)) = x(i, j)
1116 ELSE
1117 IF (ind(ij) > nbo) ma_fuscat_r21 = ma_fuscat_r21+1
1118 ENDIF
1119 ENDDO
1120 !-- Repeat the data if needed
1121 IF (MINVAL(ind) < 0) THEN
1122 DO i=1, nbi
1123 IF (ind(i) <= 0) THEN
1124 DO ii=1, ABS(ind(i))-1
1125 IF (ind(i+1)+ii <= nbo) THEN
1126 y(ind(i+1)+ii) = y(ind(i+1))
1127 ELSE
1128 ma_fuscat_r21 = ma_fuscat_r21+1
1129 ENDIF
1130 ENDDO
1131 ENDIF
1132 ENDDO
1133 ENDIF
1134 ELSE
1135 ma_fuscat_r21 = 1
1136 ENDIF
1137 !-------------------------
1138 END FUNCTION ma_fuscat_r21
1139
1140 !************************************************
1141
1142 INTEGER FUNCTION ma_fugath_r21(nb, x, nbi, ind, miss_val, nbo, y)
1143 INTEGER :: nb(2), nbo, nbi
1144 INTEGER :: ind(nbi)
1145 REAL :: x(nb(1), nb(2)), miss_val, y(nbo)
1146
1147 INTEGER :: i, j, ij, ipos
1148 !---------------------------------------------------------------------
1149 IF (nbi <= nbo) THEN
1150 ma_fugath_r21 = 0
1151 y(1:nbo) = miss_val
1152 ipos = 0
1153 DO ij=1, nbi
1154 IF (ipos+1 <= nbo) THEN
1155 IF (ind(ij) > 0) THEN
1156 j = ((ind(ij)-1)/nb(1))+1
1157 i = (ind(ij)-(j-1)*nb(1))
1158 ipos = ipos+1
1159 y(ipos) = x(i, j)
1160 ENDIF
1161 ELSE
1162 IF (ipos+1 > nbo) ma_fugath_r21 = ma_fugath_r21+1
1163 ENDIF
1164 ENDDO
1165 ELSE
1166 ma_fugath_r21 = 1
1167 ENDIF
1168 nbo = ipos
1169 !-------------------------
1170 END FUNCTION ma_fugath_r21
1171
1172 !************************************************
1173
1174 INTEGER FUNCTION ma_fufill_r21(nb, x, nbi, ind, miss_val, nbo, y)
1175 INTEGER :: nb(2), nbo, nbi
1176 INTEGER :: ind(nbi)
1177 REAL :: x(nb(1), nb(2)), miss_val, y(nbo)
1178
1179 INTEGER :: i, j, ij, ii, ipos
1180 !---------------------------------------------------------------------
1181 ma_fufill_r21 = 0
1182
1183 IF (nbi <= nb(1)*nb(2)) THEN
1184 ipos = 0
1185 DO ij=1, nbi
1186 IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
1187 ipos = ipos+1
1188 j = ((ipos-1)/nb(1))+1
1189 i = (ipos-(j-1)*nb(1))
1190 y(ind(ij)) = x(i, j)
1191 ELSE
1192 IF (ind(ij) > nbo) ma_fufill_r21 = ma_fufill_r21+1
1193 ENDIF
1194 ENDDO
1195 !-- Repeat the data if needed
1196 IF (MINVAL(ind) < 0) THEN
1197 DO i=1, nbi
1198 IF (ind(i) <= 0) THEN
1199 DO ii=1, ABS(ind(i))-1
1200 IF (ind(i+1)+ii <= nbo) THEN
1201 y(ind(i+1)+ii) = y(ind(i+1))
1202 ELSE
1203 ma_fufill_r21 = ma_fufill_r21+1
1204 ENDIF
1205 ENDDO
1206 ENDIF
1207 ENDDO
1208 ENDIF
1209 ELSE
1210 ma_fufill_r21 = 1
1211 ENDIF
1212 !-------------------------
1213 END FUNCTION ma_fufill_r21
1214
1215 !************************************************
1216
1217 INTEGER FUNCTION ma_fucoll_r21(nb, x, nbi, ind, miss_val, nbo, y)
1218 INTEGER :: nb(2), nbo, nbi
1219 INTEGER :: ind(nbi)
1220 REAL :: x(nb(1), nb(2)), miss_val, y(nbo)
1221
1222 INTEGER :: i, j, ij, ipos
1223 !---------------------------------------------------------------------
1224 IF (nbi <= nbo) THEN
1225 ma_fucoll_r21 = 0
1226 ipos = 0
1227 DO ij=1, nbi
1228 IF (ipos+1 <= nbo) THEN
1229 IF (ind(ij) > 0) THEN
1230 j = ((ind(ij)-1)/nb(1))+1
1231 i = (ind(ij)-(j-1)*nb(1))
1232 ipos = ipos+1
1233 y(ipos) = x(i, j)
1234 ENDIF
1235 ELSE
1236 IF (ipos+1 > nbo) ma_fucoll_r21 = ma_fucoll_r21+1
1237 ENDIF
1238 ENDDO
1239 ELSE
1240 ma_fucoll_r21 = 1
1241 ENDIF
1242 nbo = ipos
1243 !-------------------------
1244 END FUNCTION ma_fucoll_r21
1245
1246 !************************************************
1247
1248 INTEGER FUNCTION ma_fuundef_r21(nb, x, nbi, ind, miss_val, nbo, y)
1249 INTEGER :: nb(2), nbo, nbi
1250 INTEGER :: ind(nbi)
1251 REAL :: x(nb(1), nb(2)), miss_val, y(nbo)
1252
1253 INTEGER :: i, j, ij
1254 !---------------------------------------------------------------------
1255 IF (nbi <= nbo .AND. nbo == nb(1)*nb(2)) THEN
1256 ma_fuundef_r21 = 0
1257 DO ij=1, nbo
1258 j = ((ij-1)/nb(1))+1
1259 i = (ij-(j-1)*nb(1))
1260 y(ij) = x(i, j)
1261 ENDDO
1262 DO i=1, nbi
1263 IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
1264 y(ind(i)) = miss_val
1265 ELSE
1266 IF (ind(i) > nbo) ma_fuundef_r21 = ma_fuundef_r21+1
1267 ENDIF
1268 ENDDO
1269 ELSE
1270 ma_fuundef_r21 = 1
1271 ENDIF
1272 !--------------------------
1273 END FUNCTION ma_fuundef_r21
1274
1275 !************************************************
1276
1277 INTEGER FUNCTION ma_fuonly_r21(nb, x, nbi, ind, miss_val, nbo, y)
1278 INTEGER :: nb(2), nbo, nbi
1279 INTEGER :: ind(nbi)
1280 REAL :: x(nb(1), nb(2)), miss_val, y(nbo)
1281
1282 INTEGER :: i, j, ij
1283 !---------------------------------------------------------------------
1284 IF ( (nbi <= nbo).AND.(nbo == nb(1)*nb(2)) &
1285 & .AND.ALL(ind(1:nbi) <= nbo) ) THEN
1286 ma_fuonly_r21 = 0
1287 y(1:nbo) = miss_val
1288 DO ij=1, nbi
1289 IF (ind(ij) > 0) THEN
1290 j = ((ind(ij)-1)/nb(1))+1
1291 i = (ind(ij)-(j-1)*nb(1))
1292 y(ind(ij)) = x(i, j)
1293 ENDIF
1294 ENDDO
1295 ELSE
1296 ma_fuonly_r21 = 1
1297 ENDIF
1298 !-------------------------
1299 END FUNCTION ma_fuonly_r21
1300
1301 !************************************************
1302
1303 !************************************************
1304
1305 !=== FUNCTIONS (only one argument)
1306 !-
1307 INTEGER FUNCTION ma_sin_r31(nb, x, nbo, y)
1308 INTEGER :: nb(3), nbo, i, j, k, ij
1309 REAL :: x(nb(1), nb(2), nb(3)), y(nbo)
1310 !---------------------------------------------------------------------
1311 ij = 0
1312 DO k=1, nb(3)
1313 DO j=1, nb(2)
1314 DO i=1, nb(1)
1315 ij = ij+1
1316 y(ij) = SIN(x(i, j, k))
1317 ENDDO
1318 ENDDO
1319 ENDDO
1320
1321 nbo = nb(1)*nb(2)*nb(3)
1322 ma_sin_r31 = 0
1323 !----------------------
1324 END FUNCTION ma_sin_r31
1325
1326 !************************************************
1327
1328 INTEGER FUNCTION ma_cos_r31(nb, x, nbo, y)
1329 INTEGER :: nb(3), nbo, i, j, k, ij
1330 REAL :: x(nb(1), nb(2), nb(3)), y(nbo)
1331 !---------------------------------------------------------------------
1332 ij = 0
1333 DO k=1, nb(3)
1334 DO j=1, nb(2)
1335 DO i=1, nb(1)
1336 ij = ij+1
1337 y(ij) = COS(x(i, j, k))
1338 ENDDO
1339 ENDDO
1340 ENDDO
1341
1342 nbo = nb(1)*nb(2)*nb(3)
1343 ma_cos_r31 = 0
1344 !----------------------
1345 END FUNCTION ma_cos_r31
1346
1347 !************************************************
1348
1349 INTEGER FUNCTION ma_tan_r31(nb, x, nbo, y)
1350 INTEGER :: nb(3), nbo, i, j, k, ij
1351 REAL :: x(nb(1), nb(2), nb(3)), y(nbo)
1352 !---------------------------------------------------------------------
1353 ij = 0
1354 DO k=1, nb(3)
1355 DO j=1, nb(2)
1356 DO i=1, nb(1)
1357 ij = ij+1
1358 y(ij) = TAN(x(i, j, k))
1359 ENDDO
1360 ENDDO
1361 ENDDO
1362
1363 nbo = nb(1)*nb(2)*nb(3)
1364 ma_tan_r31 = 0
1365 !----------------------
1366 END FUNCTION ma_tan_r31
1367
1368 !************************************************
1369
1370 INTEGER FUNCTION ma_asin_r31(nb, x, nbo, y)
1371 INTEGER :: nb(3), nbo, i, j, k, ij
1372 REAL :: x(nb(1), nb(2), nb(3)), y(nbo)
1373 !---------------------------------------------------------------------
1374 ij = 0
1375 DO k=1, nb(3)
1376 DO j=1, nb(2)
1377 DO i=1, nb(1)
1378 ij = ij+1
1379 y(ij) = ASIN(x(i, j, k))
1380 ENDDO
1381 ENDDO
1382 ENDDO
1383
1384 nbo = nb(1)*nb(2)*nb(3)
1385 ma_asin_r31 = 0
1386 !-----------------------
1387 END FUNCTION ma_asin_r31
1388
1389 !************************************************
1390
1391 INTEGER FUNCTION ma_acos_r31(nb, x, nbo, y)
1392 INTEGER :: nb(3), nbo, i, j, k, ij
1393 REAL :: x(nb(1), nb(2), nb(3)), y(nbo)
1394 !---------------------------------------------------------------------
1395 ij = 0
1396 DO k=1, nb(3)
1397 DO j=1, nb(2)
1398 DO i=1, nb(1)
1399 ij = ij+1
1400 y(ij) = ACOS(x(i, j, k))
1401 ENDDO
1402 ENDDO
1403 ENDDO
1404
1405 nbo = nb(1)*nb(2)*nb(3)
1406 ma_acos_r31 = 0
1407 !-----------------------
1408 END FUNCTION ma_acos_r31
1409
1410 !************************************************
1411
1412 INTEGER FUNCTION ma_atan_r31(nb, x, nbo, y)
1413 INTEGER :: nb(3), nbo, i, j, k, ij
1414 REAL :: x(nb(1), nb(2), nb(3)), y(nbo)
1415 !---------------------------------------------------------------------
1416 ij = 0
1417 DO k=1, nb(3)
1418 DO j=1, nb(2)
1419 DO i=1, nb(1)
1420 ij = ij+1
1421 y(ij) = ATAN(x(i, j, k))
1422 ENDDO
1423 ENDDO
1424 ENDDO
1425
1426 nbo = nb(1)*nb(2)*nb(3)
1427 ma_atan_r31 = 0
1428 !-----------------------
1429 END FUNCTION ma_atan_r31
1430
1431 !************************************************
1432
1433 INTEGER FUNCTION ma_exp_r31(nb, x, nbo, y)
1434 INTEGER :: nb(3), nbo, i, j, k, ij
1435 REAL :: x(nb(1), nb(2), nb(3)), y(nbo)
1436 !---------------------------------------------------------------------
1437 ij = 0
1438 DO k=1, nb(3)
1439 DO j=1, nb(2)
1440 DO i=1, nb(1)
1441 ij = ij+1
1442 y(ij) = EXP(x(i, j, k))
1443 ENDDO
1444 ENDDO
1445 ENDDO
1446
1447 nbo = nb(1)*nb(2)*nb(3)
1448 ma_exp_r31 = 0
1449 !----------------------
1450 END FUNCTION ma_exp_r31
1451
1452 !************************************************
1453
1454 INTEGER FUNCTION ma_alog_r31(nb, x, nbo, y)
1455 INTEGER :: nb(3), nbo, i, j, k, ij
1456 REAL :: x(nb(1), nb(2), nb(3)), y(nbo)
1457 !---------------------------------------------------------------------
1458 ij = 0
1459 DO k=1, nb(3)
1460 DO j=1, nb(2)
1461 DO i=1, nb(1)
1462 ij = ij+1
1463 y(ij) = ALOG(x(i, j, k))
1464 ENDDO
1465 ENDDO
1466 ENDDO
1467
1468 nbo = nb(1)*nb(2)*nb(3)
1469 ma_alog_r31 = 0
1470 !-----------------------
1471 END FUNCTION ma_alog_r31
1472
1473 !************************************************
1474
1475 INTEGER FUNCTION ma_sqrt_r31(nb, x, nbo, y)
1476 INTEGER :: nb(3), nbo, i, j, k, ij
1477 REAL :: x(nb(1), nb(2), nb(3)), y(nbo)
1478 !---------------------------------------------------------------------
1479 ij = 0
1480 DO k=1, nb(3)
1481 DO j=1, nb(2)
1482 DO i=1, nb(1)
1483 ij = ij+1
1484 y(ij) = SQRT(x(i, j, k))
1485 ENDDO
1486 ENDDO
1487 ENDDO
1488
1489 nbo = nb(1)*nb(2)*nb(3)
1490 ma_sqrt_r31 = 0
1491 !-----------------------
1492 END FUNCTION ma_sqrt_r31
1493
1494 !************************************************
1495
1496 INTEGER FUNCTION ma_abs_r31(nb, x, nbo, y)
1497 INTEGER :: nb(3), nbo, i, j, k, ij
1498 REAL :: x(nb(1), nb(2), nb(3)), y(nbo)
1499 !---------------------------------------------------------------------
1500 ij = 0
1501 DO k=1, nb(3)
1502 DO j=1, nb(2)
1503 DO i=1, nb(1)
1504 ij = ij+1
1505 y(ij) = ABS(x(i, j, k))
1506 ENDDO
1507 ENDDO
1508 ENDDO
1509
1510 nbo = nb(1)*nb(2)*nb(3)
1511 ma_abs_r31 = 0
1512 !----------------------
1513 END FUNCTION ma_abs_r31
1514
1515 !************************************************
1516
1517 INTEGER FUNCTION ma_chs_r31(nb, x, nbo, y)
1518 INTEGER :: nb(3), nbo, i, j, k, ij
1519 REAL :: x(nb(1), nb(2), nb(3)), y(nbo)
1520 !---------------------------------------------------------------------
1521 ij = 0
1522 DO k=1, nb(3)
1523 DO j=1, nb(2)
1524 DO i=1, nb(1)
1525 ij = ij+1
1526 y(ij) = x(i, j, k)*(-1.)
1527 ENDDO
1528 ENDDO
1529 ENDDO
1530
1531 nbo = nb(1)*nb(2)*nb(3)
1532 ma_chs_r31 = 0
1533 !----------------------
1534 END FUNCTION ma_chs_r31
1535
1536 !************************************************
1537
1538 INTEGER FUNCTION ma_cels_r31(nb, x, nbo, y)
1539 INTEGER :: nb(3), nbo, i, j, k, ij
1540 REAL :: x(nb(1), nb(2), nb(3)), y(nbo)
1541 !---------------------------------------------------------------------
1542 ij = 0
1543 DO k=1, nb(3)
1544 DO j=1, nb(2)
1545 DO i=1, nb(1)
1546 ij = ij+1
1547 y(ij) = x(i, j, k)-273.15
1548 ENDDO
1549 ENDDO
1550 ENDDO
1551
1552 nbo = nb(1)*nb(2)*nb(3)
1553 ma_cels_r31 = 0
1554 !-----------------------
1555 END FUNCTION ma_cels_r31
1556
1557 !************************************************
1558
1559 INTEGER FUNCTION ma_kelv_r31(nb, x, nbo, y)
1560 INTEGER :: nb(3), nbo, i, j, k, ij
1561 REAL :: x(nb(1), nb(2), nb(3)), y(nbo)
1562 !---------------------------------------------------------------------
1563 ij = 0
1564 DO k=1, nb(3)
1565 DO j=1, nb(2)
1566 DO i=1, nb(1)
1567 ij = ij+1
1568 y(ij) = x(i, j, k)+273.15
1569 ENDDO
1570 ENDDO
1571 ENDDO
1572
1573 nbo = nb(1)*nb(2)*nb(3)
1574 ma_kelv_r31 = 0
1575 !-----------------------
1576 END FUNCTION ma_kelv_r31
1577
1578 !************************************************
1579
1580 INTEGER FUNCTION ma_deg_r31(nb, x, nbo, y)
1581 INTEGER :: nb(3), nbo, i, j, k, ij
1582 REAL :: x(nb(1), nb(2), nb(3)), y(nbo)
1583 !---------------------------------------------------------------------
1584 ij = 0
1585 DO k=1, nb(3)
1586 DO j=1, nb(2)
1587 DO i=1, nb(1)
1588 ij = ij+1
1589 y(ij) = x(i, j, k)*57.29577951
1590 ENDDO
1591 ENDDO
1592 ENDDO
1593
1594 nbo = nb(1)*nb(2)*nb(3)
1595 ma_deg_r31 = 0
1596 !----------------------
1597 END FUNCTION ma_deg_r31
1598
1599 !************************************************
1600
1601 INTEGER FUNCTION ma_rad_r31(nb, x, nbo, y)
1602 INTEGER :: nb(3), nbo, i, j, k, ij
1603 REAL :: x(nb(1), nb(2), nb(3)), y(nbo)
1604 !---------------------------------------------------------------------
1605 ij = 0
1606 DO k=1, nb(3)
1607 DO j=1, nb(2)
1608 DO i=1, nb(1)
1609 ij = ij+1
1610 y(ij) = x(i, j, k)*0.01745329252
1611 ENDDO
1612 ENDDO
1613 ENDDO
1614
1615 nbo = nb(1)*nb(2)*nb(3)
1616 ma_rad_r31 = 0
1617 !----------------------
1618 END FUNCTION ma_rad_r31
1619
1620 !************************************************
1621
1622 INTEGER FUNCTION ma_ident_r31(nb, x, nbo, y)
1623 INTEGER :: nb(3), nbo, i, j, k, ij
1624 REAL :: x(nb(1), nb(2), nb(3)), y(nbo)
1625 !---------------------------------------------------------------------
1626 ij = 0
1627 DO k=1, nb(3)
1628 DO j=1, nb(2)
1629 DO i=1, nb(1)
1630 ij = ij+1
1631 y(ij) = x(i, j, k)
1632 ENDDO
1633 ENDDO
1634 ENDDO
1635
1636 nbo = nb(1)*nb(2)*nb(3)
1637 ma_ident_r31 = 0
1638 !------------------------
1639 END FUNCTION ma_ident_r31
1640 !-
1641 !=== OPERATIONS (two argument)
1642 !-
1643 INTEGER FUNCTION ma_add_r31(nb, x, s, nbo, y)
1644 INTEGER :: nb(3), nbo
1645 REAL :: x(nb(1), nb(2), nb(3)), s, y(nbo)
1646
1647 INTEGER :: i, j, k, ij
1648 !---------------------------------------------------------------------
1649 ij = 0
1650 DO k=1, nb(3)
1651 DO j=1, nb(2)
1652 DO i=1, nb(1)
1653 ij = ij+1
1654 y(ij) = x(i, j, k)+s
1655 ENDDO
1656 ENDDO
1657 ENDDO
1658
1659 nbo = nb(1)*nb(2)*nb(3)
1660 ma_add_r31 = 0
1661 !----------------------
1662 END FUNCTION ma_add_r31
1663
1664 !************************************************
1665
1666 INTEGER FUNCTION ma_sub_r31(nb, x, s, nbo, y)
1667 INTEGER :: nb(3), nbo
1668 REAL :: x(nb(1), nb(2), nb(3)), s, y(nbo)
1669
1670 INTEGER :: i, j, k, ij
1671 !---------------------------------------------------------------------
1672 ij = 0
1673 DO k=1, nb(3)
1674 DO j=1, nb(2)
1675 DO i=1, nb(1)
1676 ij = ij+1
1677 y(ij) = x(i, j, k)-s
1678 ENDDO
1679 ENDDO
1680 ENDDO
1681
1682 nbo = nb(1)*nb(2)*nb(3)
1683 ma_sub_r31 = 0
1684 !----------------------
1685 END FUNCTION ma_sub_r31
1686
1687 !************************************************
1688
1689 INTEGER FUNCTION ma_subi_r31(nb, x, s, nbo, y)
1690 INTEGER :: nb(3), nbo
1691 REAL :: x(nb(1), nb(2), nb(3)), s, y(nbo)
1692
1693 INTEGER :: i, j, k, ij
1694 !---------------------------------------------------------------------
1695 ij = 0
1696 DO k=1, nb(3)
1697 DO j=1, nb(2)
1698 DO i=1, nb(1)
1699 ij = ij+1
1700 y(ij) = s-x(i, j, k)
1701 ENDDO
1702 ENDDO
1703 ENDDO
1704
1705 nbo = nb(1)*nb(2)*nb(3)
1706 ma_subi_r31 = 0
1707 !-----------------------
1708 END FUNCTION ma_subi_r31
1709
1710 !************************************************
1711
1712 INTEGER FUNCTION ma_mult_r31(nb, x, s, nbo, y)
1713 INTEGER :: nb(3), nbo
1714 REAL :: x(nb(1), nb(2), nb(3)), s, y(nbo)
1715
1716 INTEGER :: i, j, k, ij
1717 !---------------------------------------------------------------------
1718 ij = 0
1719 DO k=1, nb(3)
1720 DO j=1, nb(2)
1721 DO i=1, nb(1)
1722 ij = ij+1
1723 y(ij) = x(i, j, k)*s
1724 ENDDO
1725 ENDDO
1726 ENDDO
1727
1728 nbo = nb(1)*nb(2)*nb(3)
1729 ma_mult_r31 = 0
1730 !-----------------------
1731 END FUNCTION ma_mult_r31
1732
1733 !************************************************
1734
1735 INTEGER FUNCTION ma_div_r31(nb, x, s, nbo, y)
1736 INTEGER :: nb(3), nbo
1737 REAL :: x(nb(1), nb(2), nb(3)), s, y(nbo)
1738
1739 INTEGER :: i, j, k, ij
1740 !---------------------------------------------------------------------
1741 ij = 0
1742 DO k=1, nb(3)
1743 DO j=1, nb(2)
1744 DO i=1, nb(1)
1745 ij = ij+1
1746 y(ij) = x(i, j, k)/s
1747 ENDDO
1748 ENDDO
1749 ENDDO
1750
1751 nbo = nb(1)*nb(2)*nb(3)
1752 ma_div_r31 = 0
1753 !----------------------
1754 END FUNCTION ma_div_r31
1755
1756 !************************************************
1757
1758 INTEGER FUNCTION ma_divi_r31(nb, x, s, nbo, y)
1759 INTEGER :: nb(3), nbo
1760 REAL :: x(nb(1), nb(2), nb(3)), s, y(nbo)
1761
1762 INTEGER :: i, j, k, ij
1763 !---------------------------------------------------------------------
1764 ij = 0
1765 DO k=1, nb(3)
1766 DO j=1, nb(2)
1767 DO i=1, nb(1)
1768 ij = ij+1
1769 y(ij) = s/x(i, j, k)
1770 ENDDO
1771 ENDDO
1772 ENDDO
1773
1774 nbo = nb(1)*nb(2)*nb(3)
1775 ma_divi_r31 = 0
1776 !-----------------------
1777 END FUNCTION ma_divi_r31
1778
1779 !************************************************
1780
1781 INTEGER FUNCTION ma_power_r31(nb, x, s, nbo, y)
1782 INTEGER :: nb(3), nbo
1783 REAL :: x(nb(1), nb(2), nb(3)), s, y(nbo)
1784
1785 INTEGER :: i, j, k, ij
1786 !---------------------------------------------------------------------
1787 ij = 0
1788 DO k=1, nb(3)
1789 DO j=1, nb(2)
1790 DO i=1, nb(1)
1791 ij = ij+1
1792 y(ij) = x(i, j, k)**s
1793 ENDDO
1794 ENDDO
1795 ENDDO
1796
1797 nbo = nb(1)*nb(2)*nb(3)
1798 ma_power_r31 = 0
1799 !------------------------
1800 END FUNCTION ma_power_r31
1801
1802 !************************************************
1803
1804 INTEGER FUNCTION ma_fumin_r31(nb, x, s, nbo, y)
1805 INTEGER :: nb(3), nbo
1806 REAL :: x(nb(1), nb(2), nb(3)), s, y(nbo)
1807
1808 INTEGER :: i, j, k, ij
1809 !---------------------------------------------------------------------
1810 ij = 0
1811 DO k=1, nb(3)
1812 DO j=1, nb(2)
1813 DO i=1, nb(1)
1814 ij = ij+1
1815 y(ij) = MIN(x(i, j, k), s)
1816 ENDDO
1817 ENDDO
1818 ENDDO
1819
1820 nbo = nb(1)*nb(2)*nb(3)
1821 ma_fumin_r31 = 0
1822 !------------------------
1823 END FUNCTION ma_fumin_r31
1824
1825 !************************************************
1826
1827 INTEGER FUNCTION ma_fumax_r31(nb, x, s, nbo, y)
1828 INTEGER :: nb(3), nbo
1829 REAL :: x(nb(1), nb(2), nb(3)), s, y(nbo)
1830
1831 INTEGER :: i, j, k, ij
1832 !---------------------------------------------------------------------
1833 ij = 0
1834 DO k=1, nb(3)
1835 DO j=1, nb(2)
1836 DO i=1, nb(1)
1837 ij = ij+1
1838 y(ij) = MAX(x(i, j, k), s)
1839 ENDDO
1840 ENDDO
1841 ENDDO
1842
1843 nbo = nb(1)*nb(2)*nb(3)
1844 ma_fumax_r31 = 0
1845 !------------------------
1846 END FUNCTION ma_fumax_r31
1847
1848 !************************************************
1849
1850 INTEGER FUNCTION ma_fuscat_r31(nb, x, nbi, ind, miss_val, nbo, y)
1851 INTEGER :: nb(3), nbo, nbi
1852 INTEGER :: ind(nbi)
1853 REAL :: x(nb(1), nb(2), nb(3)), miss_val, y(nbo)
1854
1855 INTEGER :: i, j, k, ij, ii, ipos, ipp, isb
1856 !---------------------------------------------------------------------
1857 ma_fuscat_r31 = 0
1858
1859 y(1:nbo) = miss_val
1860
1861 IF (nbi <= nb(1)*nb(2)*nb(3)) THEN
1862 ipos = 0
1863 isb = nb(1)*nb(2)
1864 DO ij=1, nbi
1865 IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
1866 ipos = ipos+1
1867 k = ((ipos-1)/isb)+1
1868 ipp = ipos-(k-1)*isb
1869 j = ((ipp-1)/nb(1))+1
1870 i = (ipp-(j-1)*nb(1))
1871 y(ind(ij)) = x(i, j, k)
1872 ELSE
1873 IF (ind(ij) > nbo) ma_fuscat_r31 = ma_fuscat_r31+1
1874 ENDIF
1875 ENDDO
1876 !-- Repeat the data if needed
1877 IF (MINVAL(ind) < 0) THEN
1878 DO i=1, nbi
1879 IF (ind(i) <= 0) THEN
1880 DO ii=1, ABS(ind(i))-1
1881 IF (ind(i+1)+ii <= nbo) THEN
1882 y(ind(i+1)+ii) = y(ind(i+1))
1883 ELSE
1884 ma_fuscat_r31 = ma_fuscat_r31+1
1885 ENDIF
1886 ENDDO
1887 ENDIF
1888 ENDDO
1889 ENDIF
1890 ELSE
1891 ma_fuscat_r31 = 1
1892 ENDIF
1893 !-------------------------
1894 END FUNCTION ma_fuscat_r31
1895
1896 !************************************************
1897
1898 INTEGER FUNCTION ma_fugath_r31(nb, x, nbi, ind, miss_val, nbo, y)
1899 INTEGER :: nb(3), nbo, nbi
1900 INTEGER :: ind(nbi)
1901 REAL :: x(nb(1), nb(2), nb(3)), miss_val, y(nbo)
1902
1903 INTEGER :: i, j, k, ij, ipos, ipp, isb
1904 !---------------------------------------------------------------------
1905 IF (nbi <= nbo) THEN
1906 ma_fugath_r31 = 0
1907 y(1:nbo) = miss_val
1908 ipos = 0
1909 isb = nb(1)*nb(2)
1910 DO ij=1, nbi
1911 IF (ipos+1 <= nbo) THEN
1912 IF (ind(ij) > 0) THEN
1913 k = ((ind(ij)-1)/isb)+1
1914 ipp = ind(ij)-(k-1)*isb
1915 j = ((ipp-1)/nb(1))+1
1916 i = (ipp-(j-1)*nb(1))
1917 ipos = ipos+1
1918 y(ipos) = x(i, j, k)
1919 ENDIF
1920 ELSE
1921 IF (ipos+1 > nbo) ma_fugath_r31 = ma_fugath_r31+1
1922 ENDIF
1923 ENDDO
1924 ELSE
1925 ma_fugath_r31 = 1
1926 ENDIF
1927 nbo = ipos
1928 !-------------------------
1929 END FUNCTION ma_fugath_r31
1930
1931 !************************************************
1932
1933 INTEGER FUNCTION ma_fufill_r31(nb, x, nbi, ind, miss_val, nbo, y)
1934 INTEGER :: nb(3), nbo, nbi
1935 INTEGER :: ind(nbi)
1936 REAL :: x(nb(1), nb(2), nb(3)), miss_val, y(nbo)
1937
1938 INTEGER :: i, j, k, ij, ii, ipos, ipp, isb
1939 !---------------------------------------------------------------------
1940 ma_fufill_r31 = 0
1941 IF (nbi <= nb(1)*nb(2)*nb(3)) THEN
1942 ipos = 0
1943 isb = nb(1)*nb(2)
1944 DO ij=1, nbi
1945 IF (ind(ij) <= nbo .AND. ind(ij) > 0) THEN
1946 ipos = ipos+1
1947 k = ((ipos-1)/isb)+1
1948 ipp = ipos-(k-1)*isb
1949 j = ((ipp-1)/nb(1))+1
1950 i = (ipp-(j-1)*nb(1))
1951 y(ind(ij)) = x(i, j, k)
1952 ELSE
1953 IF (ind(ij) > nbo) ma_fufill_r31 = ma_fufill_r31+1
1954 ENDIF
1955 ENDDO
1956 !-- Repeat the data if needed
1957 IF (MINVAL(ind) < 0) THEN
1958 DO i=1, nbi
1959 IF (ind(i) <= 0) THEN
1960 DO ii=1, ABS(ind(i))-1
1961 IF (ind(i+1)+ii <= nbo) THEN
1962 y(ind(i+1)+ii) = y(ind(i+1))
1963 ELSE
1964 ma_fufill_r31 = ma_fufill_r31+1
1965 ENDIF
1966 ENDDO
1967 ENDIF
1968 ENDDO
1969 ENDIF
1970 ELSE
1971 ma_fufill_r31 = 1
1972 ENDIF
1973 !-------------------------
1974 END FUNCTION ma_fufill_r31
1975
1976 !************************************************
1977
1978 INTEGER FUNCTION ma_fucoll_r31(nb, x, nbi, ind, miss_val, nbo, y)
1979 INTEGER :: nb(3), nbo, nbi
1980 INTEGER :: ind(nbi)
1981 REAL :: x(nb(1), nb(2), nb(3)), miss_val, y(nbo)
1982
1983 INTEGER :: i, j, k, ij, ipos, ipp, isb
1984 !---------------------------------------------------------------------
1985 IF (nbi <= nbo) THEN
1986 ma_fucoll_r31 = 0
1987 ipos = 0
1988 isb = nb(1)*nb(2)
1989 DO ij=1, nbi
1990 IF (ipos+1 <= nbo) THEN
1991 IF (ind(ij) > 0) THEN
1992 k = ((ind(ij)-1)/isb)+1
1993 ipp = ind(ij)-(k-1)*isb
1994 j = ((ipp-1)/nb(1))+1
1995 i = (ipp-(j-1)*nb(1))
1996 ipos = ipos+1
1997 y(ipos) = x(i, j, k)
1998 ENDIF
1999 ELSE
2000 IF (ipos+1 > nbo) ma_fucoll_r31 = ma_fucoll_r31+1
2001 ENDIF
2002 ENDDO
2003 ELSE
2004 ma_fucoll_r31 = 1
2005 ENDIF
2006 nbo = ipos
2007 !-------------------------
2008 END FUNCTION ma_fucoll_r31
2009
2010 !************************************************
2011
2012 INTEGER FUNCTION ma_fuundef_r31(nb, x, nbi, ind, miss_val, nbo, y)
2013 INTEGER :: nb(3), nbo, nbi
2014 INTEGER :: ind(nbi)
2015 REAL :: x(nb(1), nb(2), nb(3)), miss_val, y(nbo)
2016
2017 INTEGER :: i, j, k, ij, ipp, isb
2018 !---------------------------------------------------------------------
2019 IF (nbi <= nbo .AND. nbo == nb(1)*nb(2)*nb(3)) THEN
2020 ma_fuundef_r31 = 0
2021 isb = nb(1)*nb(2)
2022 DO ij=1, nbo
2023 k = ((ij-1)/isb)+1
2024 ipp = ij-(k-1)*isb
2025 j = ((ipp-1)/nb(1))+1
2026 i = (ipp-(j-1)*nb(1))
2027 y(ij) = x(i, j, k)
2028 ENDDO
2029 DO i=1, nbi
2030 IF (ind(i) <= nbo .AND. ind(i) > 0) THEN
2031 y(ind(i)) = miss_val
2032 ELSE
2033 IF (ind(i) > nbo) ma_fuundef_r31 = ma_fuundef_r31+1
2034 ENDIF
2035 ENDDO
2036 ELSE
2037 ma_fuundef_r31 = 1
2038 ENDIF
2039 !--------------------------
2040 END FUNCTION ma_fuundef_r31
2041
2042 !************************************************
2043
2044 INTEGER FUNCTION ma_fuonly_r31(nb, x, nbi, ind, miss_val, nbo, y)
2045 INTEGER :: nb(3), nbo, nbi
2046 INTEGER :: ind(nbi)
2047 REAL :: x(nb(1), nb(2), nb(3)), miss_val, y(nbo)
2048
2049 INTEGER :: i, j, k, ij, ipp, isb
2050 !---------------------------------------------------------------------
2051 IF ( (nbi <= nbo).AND.(nbo == nb(1)*nb(2)*nb(3)) &
2052 & .AND.ALL(ind(1:nbi) <= nbo) ) THEN
2053 ma_fuonly_r31 = 0
2054 y(1:nbo) = miss_val
2055 isb = nb(1)*nb(2)
2056 DO ij=1, nbi
2057 IF (ind(ij) > 0) THEN
2058 k = ((ind(ij)-1)/isb)+1
2059 ipp = ind(ij)-(k-1)*isb
2060 j = ((ipp-1)/nb(1))+1
2061 i = (ipp-(j-1)*nb(1))
2062 y(ind(ij)) = x(i, j, k)
2063 ENDIF
2064 ENDDO
2065 ELSE
2066 ma_fuonly_r31 = 1
2067 ENDIF
2068 !-------------------------
2069 END FUNCTION ma_fuonly_r31
2070
2071 END MODULE mathop2
  ViewVC Help
Powered by ViewVC 1.1.21