Changeset 1725 for trunk/NEMO/OPA_SRC/IOM/iom.F90
- Timestamp:
- 2009-11-12T16:04:08+01:00 (14 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/IOM/iom.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/IOM/iom.F90
r1697 r1725 27 27 28 28 #if defined key_iomput 29 USE sbc_oce, ONLY : nn_fsbc ! ocean space and time domain 30 USE domngb ! ocean space and time domain 31 USE phycst ! physical constants 32 USE dianam ! build name of file 29 33 USE mod_event_client 34 USE mod_attribut 30 35 # endif 31 36 … … 34 39 35 40 #if defined key_iomput 36 LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .TRUE. !: iom_put flag41 LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .TRUE. !: iom_put flag 37 42 #else 38 43 LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .FALSE. !: iom_put flag … … 70 75 CONTAINS 71 76 72 SUBROUTINE iom_init ( pjulian )77 SUBROUTINE iom_init 73 78 !!---------------------------------------------------------------------- 74 79 !! *** ROUTINE *** … … 77 82 !! 78 83 !!---------------------------------------------------------------------- 79 REAL(wp), INTENT(in) :: pjulian !: julian day at nit000 = 080 84 #if defined key_iomput 81 85 !!---------------------------------------------------------------------- … … 84 88 85 89 ! calendar parameters 86 CALL event__set_time_parameters( nit000 - 1, pjulian, rdt ) 90 SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL 91 CASE ( 1) ; CALL event__set_calendar('gregorian') 92 CASE ( 0) ; CALL event__set_calendar('noleap' ) 93 CASE (30) ; CALL event__set_calendar('360d' ) 94 END SELECT 95 CALL event__set_time_parameters( nit000 - 1, fjulday - adatrj, rdt ) 87 96 88 97 ! horizontal grid definition … … 97 106 CALL event__set_vert_axis( "depthv", gdept_0 ) 98 107 CALL event__set_vert_axis( "depthw", gdepw_0 ) 108 109 ! automatic definitions of some of the xml attributs 110 CALL set_xmlatt 99 111 100 112 ! end file definition … … 925 937 !! *** ROUTINE *** 926 938 !! 927 !! ** Purpose : 939 !! ** Purpose : define horizontal grids 928 940 !! 929 941 !!---------------------------------------------------------------------- … … 939 951 END SUBROUTINE set_grid 940 952 953 954 SUBROUTINE set_xmlatt 955 !!---------------------------------------------------------------------- 956 !! *** ROUTINE *** 957 !! 958 !! ** Purpose : automatic definitions of some of the xml attributs... 959 !! 960 !!---------------------------------------------------------------------- 961 CHARACTER(len=6),DIMENSION( 5) :: clsuff ! suffix name 962 CHARACTER(len=1),DIMENSION( 3) :: clgrd ! suffix name 963 CHARACTER(len=50) :: clname ! file name 964 CHARACTER(len=1) :: cl1 ! 1 character 965 CHARACTER(len=2) :: cl2 ! 1 character 966 INTEGER :: idt ! time-step in seconds 967 INTEGER :: iddss, ihhss, iyyss ! number of seconds in 1 day, 1 hour and 1 year 968 INTEGER :: ji, jj, jg, jh, jd, jy ! loop counters 969 INTEGER :: ix, iy ! i-,j- index 970 REAL(wp) ,DIMENSION(11) :: zlontao ! longitudes of tao moorings 971 REAL(wp) ,DIMENSION( 7) :: zlattao ! latitudes of tao moorings 972 REAL(wp) ,DIMENSION( 4) :: zlonrama ! longitudes of rama moorings 973 REAL(wp) ,DIMENSION(11) :: zlatrama ! latitudes of rama moorings 974 REAL(wp) ,DIMENSION( 3) :: zlonpira ! longitudes of pirata moorings 975 REAL(wp) ,DIMENSION( 9) :: zlatpira ! latitudes of pirata moorings 976 !!---------------------------------------------------------------------- 977 ! 978 idt = NINT( rdttra(1) ) 979 iddss = NINT( rday ) ! number of seconds in 1 day 980 ihhss = NINT( rmmss * rhhmm ) ! number of seconds in 1 hour 981 iyyss = nyear_len(1) * iddss ! number of seconds in 1 year 982 983 ! frequency of the call of iom_put (attribut: freq_op) 984 CALL event__set_attribut( 'field_definition', attr( field__freq_op, idt ) ) ! model time-step 985 CALL event__set_attribut( 'SBC' , attr( field__freq_op, idt * nn_fsbc ) ) ! SBC time-step 986 ! average frequency: directly specified in the xml file except for yearly mean (attribut: output_freq) 987 ! note that average frequency of -1 correspond to exact monthly mean (-> according to the calendar) 988 DO jy = 1, 10 ! 1, 2, 5, 10 years 989 IF( MOD(10,jy) == 0 ) THEN 990 WRITE(cl2,'(i1)') jy 991 CALL event__set_attribut( TRIM(ADJUSTL(cl2))//'y', attr( file__output_freq, jy * iyyss ) ) 992 ENDIF 993 END DO 994 995 ! output file names (attribut: name) 996 clsuff(:) = (/ 'grid_T', 'grid_U', 'grid_V', 'grid_W', 'icemod' /) 997 DO jg = 1, SIZE(clsuff) ! grid type 998 DO jh = 1, 12 ! 1, 2, 3, 4, 6, 12 hours 999 IF( MOD(12,jh) == 0 ) THEN 1000 WRITE(cl2,'(i2)') jh 1001 CALL dia_nam( clname, jh * ihhss, clsuff(jg), ldfsec = .TRUE. ) 1002 CALL event__set_attribut( TRIM(ADJUSTL(cl2))//'h_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 1003 ENDIF 1004 END DO 1005 DO jd = 1, 5, 2 ! 1, 3, 5 days 1006 WRITE(cl1,'(i1)') jd 1007 CALL dia_nam( clname, jd * iddss, clsuff(jg), ldfsec = .TRUE. ) 1008 CALL event__set_attribut( cl1//'d_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 1009 END DO 1010 CALL dia_nam( clname, -1, clsuff(jg) ) ! 1 month 1011 CALL event__set_attribut( '1m_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 1012 DO jy = 1, 10 ! 1, 2, 5, 10 years 1013 IF( MOD(10,jy) == 0 ) THEN 1014 WRITE(cl2,'(i2)') jy 1015 CALL dia_nam( clname, jy * iyyss, clsuff(jg), ldfsec = .TRUE. ) 1016 CALL event__set_attribut( TRIM(ADJUSTL(cl2))//'y_'//clsuff(jg), attr( file__name, TRIM(clname) ) ) 1017 ENDIF 1018 END DO 1019 END DO 1020 1021 ! Zooms... 1022 clgrd = (/ 'T', 'U', 'W' /) 1023 DO jg = 1, SIZE(clgrd) ! grid type 1024 cl1 = clgrd(jg) 1025 ! Equatorial section (attributs: jbegin, ni, name_suffix) 1026 CALL dom_ngb( 0., 0., ix, iy, cl1 ) 1027 CALL event__set_attribut( 'Eq'//cl1, attr( zoom__jbegin , iy ) ) 1028 CALL event__set_attribut( 'Eq'//cl1, attr( zoom__ni , jpiglo ) ) 1029 CALL event__set_attribut( 'Eq'//cl1, attr( file__name_suffix, '_Eq' ) ) 1030 END DO 1031 ! TAO moorings (attributs: ibegin, jbegin, name_suffix) 1032 zlontao = (/ 137.0, 147.0, 156.0, 165.0, -180.0, -170.0, -155.0, -140.0, -125.0, -110.0, -95.0 /) 1033 zlattao = (/ -8.0, -5.0, -2.0, 0.0, 2.0, 5.0, 8.0 /) 1034 CALL set_mooring( zlontao, zlattao ) 1035 ! RAMA moorings (attributs: ibegin, jbegin, name_suffix) 1036 zlonrama = (/ 55.0, 67.0, 80.5, 90.0 /) 1037 zlatrama = (/ -16.0, -12.0, -8.0, -4.0, -1.5, 0.0, 1.5, 4.0, 8.0, 12.0, 15.0 /) 1038 CALL set_mooring( zlonrama, zlatrama ) 1039 ! PIRATA moorings (attributs: ibegin, jbegin, name_suffix) 1040 zlonpira = (/ -38.0, -23.0, -10.0 /) 1041 zlatpira = (/ -19.0, -14.0, -8.0, 0.0, 4.0, 8.0, 12.0, 15.0, 20.0 /) 1042 CALL set_mooring( zlonpira, zlatpira ) 1043 1044 END SUBROUTINE set_xmlatt 1045 1046 1047 SUBROUTINE set_mooring( plon, plat) 1048 !!---------------------------------------------------------------------- 1049 !! *** ROUTINE *** 1050 !! 1051 !! ** Purpose : automatic definitions of moorings xml attributs... 1052 !! 1053 !!---------------------------------------------------------------------- 1054 REAL(wp), DIMENSION(:), INTENT(in) :: plon, plat ! longitudes/latitudes oft the mooring 1055 ! 1056 !!$ CHARACTER(len=1),DIMENSION(4) :: clgrd = (/ 'T', 'U', 'V', 'W' /) ! suffix name 1057 CHARACTER(len=1),DIMENSION(1) :: clgrd = (/ 'T' /) ! suffix name 1058 CHARACTER(len=50) :: clname ! file name 1059 CHARACTER(len=1) :: cl1 ! 1 character 1060 CHARACTER(len=6) :: clon,clat ! name of longitude, latitude 1061 INTEGER :: ji, jj, jg ! loop counters 1062 INTEGER :: ix, iy ! i-,j- index 1063 REAL(wp) :: zlon, zlat 1064 !!---------------------------------------------------------------------- 1065 DO jg = 1, SIZE(clgrd) 1066 cl1 = clgrd(jg) 1067 DO ji = 1, SIZE(plon) 1068 DO jj = 1, SIZE(plat) 1069 zlon = plon(ji) 1070 zlat = plat(jj) 1071 ! modifications for RAMA moorings 1072 IF( zlon == 67. .AND. zlat == 15. ) zlon = 65. 1073 IF( zlon == 90. .AND. zlat <= -4. ) zlon = 95. 1074 IF( zlon == 95. .AND. zlat == -4. ) zlat = -5. 1075 ! modifications for PIRATA moorings 1076 IF( zlon == -38. .AND. zlat == -19. ) zlon = -34. 1077 IF( zlon == -38. .AND. zlat == -14. ) zlon = -32. 1078 IF( zlon == -38. .AND. zlat == -8. ) zlon = -30. 1079 IF( zlon == -38. .AND. zlat == 0. ) zlon = -35. 1080 IF( zlon == -23. .AND. zlat == 20. ) zlat = 21. 1081 IF( zlon == -10. .AND. zlat == -14. ) zlat = -10. 1082 IF( zlon == -10. .AND. zlat == -8. ) zlat = -6. 1083 IF( zlon == -10. .AND. zlat == 4. ) THEN ; zlon = 0. ; zlat = 0. ; ENDIF 1084 CALL dom_ngb( zlon, zlat, ix, iy, cl1 ) 1085 IF( zlon >= 0. ) THEN 1086 IF( zlon == REAL(NINT(zlon), wp) ) THEN ; WRITE(clon, '(i3, a)') NINT( zlon), 'e' 1087 ELSE ; WRITE(clon, '(f5.1,a)') zlon , 'e' 1088 ENDIF 1089 ELSE 1090 IF( zlon == REAL(NINT(zlon), wp) ) THEN ; WRITE(clon, '(i3, a)') NINT(-zlon), 'w' 1091 ELSE ; WRITE(clon, '(f5.1,a)') -zlon , 'w' 1092 ENDIF 1093 ENDIF 1094 IF( zlat >= 0. ) THEN 1095 IF( zlat == REAL(NINT(zlat), wp) ) THEN ; WRITE(clat, '(i2, a)') NINT( zlat), 'n' 1096 ELSE ; WRITE(clat, '(f4.1,a)') zlat , 'n' 1097 ENDIF 1098 ELSE 1099 IF( zlat == REAL(NINT(zlat), wp) ) THEN ; WRITE(clat, '(i2, a)') NINT(-zlat), 's' 1100 ELSE ; WRITE(clat, '(f4.1,a)') -zlat , 's' 1101 ENDIF 1102 ENDIF 1103 clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon)) 1104 IF( lwp ) WRITE(numout,*) 'sebseb : ', '_'//TRIM(clname)//'_' 1105 CALL event__set_attribut( TRIM(clname)//cl1, attr( zoom__ibegin , ix ) ) 1106 CALL event__set_attribut( TRIM(clname)//cl1, attr( zoom__jbegin , iy ) ) 1107 CALL event__set_attribut( TRIM(clname)//cl1, attr( file__name_suffix, '_'//TRIM(clname) ) ) 1108 END DO 1109 END DO 1110 END DO 1111 1112 END SUBROUTINE set_mooring 1113 941 1114 #else 942 1115
Note: See TracChangeset
for help on using the changeset viewer.
